summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-06-02 17:49:14 +0000
committerNorbert Preining <preining@logic.at>2007-06-02 17:49:14 +0000
commit4dc41c7ce0ba9d2d0f679d1d6825b5b29a4ccb35 (patch)
treeef81201ea064cc9d5c37e590b8ad9fa2e4e2910c
parent071ffccada1a34c3aa94fe1e5bfb0354a742d699 (diff)
loads of new-infra chnages, many things implemented (zip, multiarch, ...)
git-svn-id: svn://tug.org/texlive/trunk@4405 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--new-infra/Perl-API.txt36
-rw-r--r--new-infra/TLDB.pm25
-rw-r--r--new-infra/TLP.pm110
-rw-r--r--new-infra/TLTREE.pm92
-rw-r--r--new-infra/TLUtils.pm73
-rw-r--r--new-infra/TODO4
-rwxr-xr-xnew-infra/etc/create-tlsrc-from-tpm.pl43
-rw-r--r--new-infra/specification.txt8
-rw-r--r--new-infra/test-tldb.pl30
-rw-r--r--new-infra/test-tlp2.pl26
-rw-r--r--new-infra/test-tltree.pl7
-rw-r--r--new-infra/tlsrc/bar.tlsrc1
12 files changed, 348 insertions, 107 deletions
diff --git a/new-infra/Perl-API.txt b/new-infra/Perl-API.txt
index 8243c45936e..e5d2d50d8df 100644
--- a/new-infra/Perl-API.txt
+++ b/new-infra/Perl-API.txt
@@ -36,6 +36,10 @@ Generation function
Module TLP
----------
+Package variables:
+ &TLP->zipdir
+ set/returns the default location for created zip files
+
Constructur:
TLP->new;
TLP->new( name => "foobar", ...);
@@ -54,15 +58,22 @@ Input/Output
without arg to stdout
with arg to filehandle
- $tlp->make_zip($ziploc)
- creates a zip file of the tlp in $ziploc
- zip $ziploc files ...
- NOT IMPLEMENTED
-
+ $tlp->make_zip($tltree[,$destdir[,$zipname]]);
+ creates a zip file of the tlp in $destdir (if not
+ defined then TLP->zipdir is used).
+ The file name of the created zipfile is $zipname (if not
+ present $tlp->name.zip)
+
+ If the package contains "binfiles"; then zip files for
+ all archs containing binfiles are created, and the zipfile
+ name is
+ $zipname-$arch.zip
Utilities:
$tlp->recompute_sizes($tltree)
recomputes all the *size fields, see below
+ $tlp->is_arch_dependent
+ true if it contains bin files, otherwise false
Read/Write functions (with argument set, without arg read)
@@ -144,7 +155,8 @@ Other functions
$tltree->size_of($file)
returns the size of $file, or undef if not in tree
- $tlsrc->architectures
+ &$tlsrc->architectures
+ sets/reads the list of architectures,
predefined to ....
@@ -189,4 +201,14 @@ TLP interface
returns undef if not installed, otherwise the
revision of "packagename"
-
+
+Package TLUtils
+---------------
+
+exported functions:
+ sort_uniq(@list)
+ push_uniq(\@list,@list)
+ dirname($file)
+ basename($file)
+
+
diff --git a/new-infra/TLDB.pm b/new-infra/TLDB.pm
index 5d220b8c04d..c04df256721 100644
--- a/new-infra/TLDB.pm
+++ b/new-infra/TLDB.pm
@@ -8,13 +8,15 @@
package TLDB;
+use TLUtils;
use TLP;
sub new {
my $class = shift;
my %params = @_;
my $self = {
- location => $params{'location'};
+ location => $params{'location'},
+ tlps => $params{'tlps'}
};
if (defined($self->{'location'})) {
$self->from_file($self->{'location'});
@@ -25,7 +27,7 @@ sub new {
sub add_tlp {
my ($self,$tlp) = @_;
- $self->{$tlp->name} = $tlp;
+ $self->{'tlps'}{$tlp->name} = $tlp;
}
sub from_file {
@@ -43,6 +45,7 @@ sub from_file {
my $found = 0;
do {
my $tlp = TLP->new;
+ &TLUtils::debug("creating tlp ...\n");
$found = $tlp->from_fh(\*TMP,1);
if ($found) {
$self->add_tlp($tlp);
@@ -53,8 +56,10 @@ sub from_file {
sub writeout {
my $self = shift;
my $fd = (@_ ? $_[0] : STDOUT);
- foreach (sort keys %$self) {
- $self->{$_}->writeout($fd);
+ foreach (sort keys %{$self->{'tlps'}}) {
+ &TLUtils::debug("tlpname = $_\n");
+ &TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name . "\n");
+ $self->{'tlps'}{$_}->writeout($fd);
print $fd "\n";
}
}
@@ -68,8 +73,8 @@ sub save {
sub get_package {
my ($self,$pkg) = @_;
- if (defined($self->{$pkg})) {
- return($self->{$pkg});
+ if (defined($self->{'tlps'}{$pkg})) {
+ return($self->{'tlps'}{$pkg});
} else {
return(undef);
}
@@ -77,8 +82,8 @@ sub get_package {
sub package_revision {
my ($self,$pkg) = @_;
- if (defined($self->{$pkg})) {
- return($self->{$pkg}->revision);
+ if (defined($self->{'tlps'}{$pkg})) {
+ return($self->{'tlps'}{$pkg}->revision);
} else {
return(undef);
}
@@ -87,8 +92,8 @@ sub package_revision {
sub generate_packagelist {
my $self = shift;
my $fd = (@_ ? $_[0] : STDOUT);
- foreach (sort keys %$self) {
- print $fd $self->{$_}->name, " ", $self->{$_}->revision, "\n";
+ foreach (sort keys %{$self->{'tlps'}}) {
+ print $fd $self->{'tlps'}{$_}->name, " ", $self->{'tlps'}{$_}->revision, "\n";
}
}
diff --git a/new-infra/TLP.pm b/new-infra/TLP.pm
index 3cf126ea0fc..b2bb6f2a969 100644
--- a/new-infra/TLP.pm
+++ b/new-infra/TLP.pm
@@ -8,10 +8,14 @@
package TLP;
+use TLUtils;
+use File::Path;
+use Cwd;
use TLTREE;
use FileHandle;
my $_tmp;
+my $_zipdir;
sub new {
my $class = shift;
@@ -34,6 +38,7 @@ sub new {
depends => defined($params{'depends'}) ? $params{'depends'} : [],
revision => $params{'revision'},
};
+ $_zipdir = $params{'zipdir'} if defined($params{'zipdir'});
bless $self, $class;
return $self;
}
@@ -55,6 +60,8 @@ sub from_fh {
my $size;
while (my $line = $fh->getline) {
+ &TLUtils::debug("reading line: >>>$line<<<\n");
+ &TLUtils::debug("multi=...$multi...\n");
$line =~ /^\s*#/ && next; # skip comment lines
if ($line =~ /^\s*$/) {
if (!$started) { next; }
@@ -79,7 +86,7 @@ sub from_fh {
die("Continuation of $lastcmd not allowed, please fix tlp!\n");
}
}
- if ($line =~ /^name\s*(\w+)$/) {
+ if ($line =~ /^name\s*([-\w]+)$/) {
$name = "$1";
$lastcmd = "name";
$self->name("$name");
@@ -88,15 +95,18 @@ sub from_fh {
} else {
$started || die("First directive needs to be 'name'");
if ($line =~ /^shortdesc\s+(.*)$/) {
- $self->{'shortdesc'} .= "$1 ";
+ $self->{'shortdesc'} .= "$1";
$lastcmd = "shortdesc";
next;
} elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) {
- $self->{'longdesc'} .= "$2 ";
+ if ("$1" eq "continued") {
+ $self->{'longdesc'} .= " ";
+ }
+ $self->{'longdesc'} .= "$2";
$lastcmd = "longdesc";
next;
} elsif ($line =~ /^revision\s+(.*)$/) {
- $self->{'revision'} .= "$1 ";
+ $self->{'revision'} .= "$1";
$lastcmd = "revision";
next;
} elsif ($line =~ /^catalogue\s+(.*)$/) {
@@ -248,14 +258,85 @@ sub writeout {
}
sub make_zip {
- my ($self,$ziploc) = @_;
- print STDERR "NOT IMPLEMENTED\n";
- print STDERR "Should create a zip file of the tlp in $ziploc\n";
- return;
- # we have to get all files listed in the $self->{'runfiles'} etc
- # and put them in a zip file.
- # First we have to chdir into $TEXLIVEROOT (this variable has
- # to be set by the CALLING program!!!!
+ my ($self,$tltree,$destdir,$zipname) = @_;
+ my $zipn;
+ if (not(defined($zipname))) {
+ $zipname = $self->name . ".zip";
+ }
+ if (not(defined($destdir))) {
+ $destdir = TLP->zipdir;
+ }
+ die("Undefined tltree argument!") if (not(defined($tltree)));
+ if ($self->is_arch_dependent) {
+ foreach my $t ($tltree->architectures) {
+ if (defined($self->{'binfiles'}{$t})) {
+ &TLUtils::debug("arch=$t\n");
+ if ($zipname =~ /^(.*)\.zip$/) {
+ $zipn = "$1-$t.zip";
+ } else {
+ $zipn = "$zipname-$t.zip";
+ }
+ $self->_make_zip($tltree,$destdir,$zipn,$t);
+ }
+ }
+ } else {
+ $self->_make_zip($tltree,$destdir,$zipname,"all");
+ }
+}
+
+sub _make_zip {
+ my ($self,$tltree,$destdir,$zipname,$arch) = @_;
+ my $root = $tltree->svnroot;
+ my @files = ();
+ my $zipcmd;
+ push @files, $self->runfiles;
+ push @files, $self->docfiles;
+ push @files, $self->srcfiles;
+ if ($arch ne "all") {
+ push @files, @{$self->{'binfiles'}{$arch}};
+ }
+ # note that the Tpm.pm module had something like
+ # if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
+ # $zipcmd = "| zip -9\@ory "
+ # } else {
+ # $zipcmd = "| zip -9\@or "
+ # }
+ if ($^O =~ /MSWin32/) {
+ $nul = "nul";
+ $zipcmd = "| zip -9\@or "
+ } else {
+ $nul = "/dev/null";
+ $zipcmd = "| zip -9\@ory "
+ }
+ @files = TLUtils::sort_uniq(@files);
+ if (!@files) {
+ &TLUtils::debug("Not creating empty zip file $zipname\n");
+ return;
+ }
+ &mkpath("$destdir") if (! -d "$destdir");
+ my $cwd = &getcwd;
+ chdir($tltree->svnroot);
+ unlink($zipname);
+ print $zipcmd . "$destdir/$zipname" . " > $nul\n" if ($::opt_debug);
+ open ZIP, $zipcmd . "$destdir/$zipname" . " > $nul";
+ map {
+ if (! -f $_) {
+ print STDERR "!!!Error: non-existent $_\n";
+ } else {
+ print ZIP "$_\n";
+ }
+ } @files;
+ close ZIP;
+ print "Done $zipname\n" if ($::opt_debug);
+}
+
+sub is_arch_dependent {
+ my $self = shift;
+ if (keys %{$self->{'binfiles'}}) {
+ return 1;
+ } else {
+ return 0;
+ }
}
#
@@ -360,6 +441,11 @@ sub executes {
return @{ $self->{'executes'} };
}
+sub zipdir {
+ my @self = shift;
+ if (@_) { $_zipdir = $_[0] }
+ return $_zipdir;
+}
1;
diff --git a/new-infra/TLTREE.pm b/new-infra/TLTREE.pm
index 60377e12d83..c45192b526d 100644
--- a/new-infra/TLTREE.pm
+++ b/new-infra/TLTREE.pm
@@ -8,6 +8,8 @@
package TLTREE;
+use TLUtils;
+
my @Architectures = qw/alpha-linux hppa-hpux i386-darwin i386-freebsd
i386-linux i386-openbsd i386-solaris mips-irix powerpc-aix powerpc-darwin
powerpc-linux sparc-linux sparc-solaris win32 x86_64-linux/;
@@ -54,20 +56,18 @@ sub _initialize_lines {
foreach my $l (@lines) {
chomp($l);
next if ($l =~ /^\?/); # ignore files not under version control
- if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+(\d+)\s+\w+\s+(.+)$/) {
+ if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+([\d\?]+)\s+([\w\?]+)\s+(.+)$/) {
my $lastchanged = $8;
- my $entry = "$9";
+ my $entry = "$10";
next if -d $entry; # TODO: what to do with links???
$self->{'_allfiles'}{$entry}{'lastchangedrev'} = $lastchanged;
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,
- $mtime,$ctime,$bklsize,$blocks) = stat($entry);
- $self->{'_allfiles'}{$entry}{'size'} = $size;
- my $fn = basename($entry);
- my $dn = dirname($entry);
+ $self->{'_allfiles'}{$entry}{'size'} = (lstat $entry)[7];
+ my $fn = TLUtils::basename($entry);
+ my $dn = TLUtils::dirname($entry);
add_path_to_tree($self->{'_dirtree'}, split("[/\\\\]", $dn));
push @{$self->{'_filesofdir'}{$dn}}, $fn;
} else {
- die("Cannot read svn status output line: $l");
+ die("Cannot read svn status output line:\n $l\n");
}
}
# now do some magic
@@ -142,42 +142,6 @@ sub add_path_to_tree {
return $node;
}
-sub member {
- my ($e, @l) = @_;
- my ($f);
- foreach $f (@l) {
- if ($e eq $f) {
- return 1;
- }
- }
- return 0;
-}
-
-sub push_uniq {
- my ($l,@le) = @_;
- my ($e);
- foreach $e (@le) {
- if (! &member($e, @$l)) {
- push @$l, $e;
- }
- }
-}
-
-sub dirname {
- my ($f) = @_;
- if ($f =~ m@(^.*)[\\/][^\\/]*$@) {
- return $1;
- } else {
- return ".";
- }
-}
-
-sub basename {
- my ($f) = @_;
- $f =~ m@([^\\/]*)$@;
- return $1;
-}
-
sub file_svn_lastrevision {
my $self = shift;
my $fn = shift;
@@ -224,9 +188,7 @@ sub _get_matching_files {
if ($pattype eq "t") {
@matchfiles = $self->_get_files_matching_dir_pattern($type,$patdata,@rest);
} elsif ($pattype eq "f") {
- if (defined($self->{'_allfiles'}{$patdata})) {
- @matchfiles = ( $patdata );
- }
+ @matchfiles = $self->_get_files_matching_glob_pattern($type,$patdata);
} elsif ($pattype eq "r") {
@matchfiles = $self->_get_files_matching_regexp_pattern($type,$patdata);
} elsif ($pattype eq "d") {
@@ -237,13 +199,41 @@ sub _get_matching_files {
return @matchfiles;
}
+#
+# we transform a glob pattern to a regexp pattern:
+# currently supported globs: ? *
+#
+# sequences of subsitutions:
+# . -> \.
+# * -> .*
+# ? -> .
+sub _get_files_matching_glob_pattern {
+ my $self = shift;
+ my ($type,$globline) = @_;
+ my @returnfiles;
+ my $dirpart = TLUtils::dirname($globline);
+ my $basepart = TLUtils::basename($globline);
+ $basepart =~ s/\./\\./;
+ $basepart =~ s/\*/.*/;
+ $basepart =~ s/\?/./;
+ return unless (defined($self->{'_filesofdir'}{$dirpart}));
+ my @candfiles = @{$self->{'_filesofdir'}{$dirpart}};
+ foreach my $f (@candfiles) {
+ &TLUtils::debug("matching $f in $dirpart via glob $globline\n");
+ if ($f =~ /^$basepart$/) {
+ push @returnfiles, $f;
+ }
+ }
+ return(@returnfiles);
+}
+
sub _get_files_matching_regexp_pattern {
my $self = shift;
my ($type,$regexp) = @_;
my @returnfiles;
FILELABEL: foreach my $f (keys(%{$self->{'_allfiles'}})) {
if ($f =~ /^$regexp$/) {
- push_uniq(\@returnfiles,$f);
+ TLUtils::push_uniq(\@returnfiles,$f);
next FILELABEL;
}
}
@@ -258,7 +248,7 @@ sub _get_files_matching_dir_pattern {
foreach my $tld (@{$self->{'_dirnames'}{$tl}}) {
if (index($tld,join("/",@patwords)."/") == 0) {
my @files = $self->files_under_path($tld);
- push_uniq(\@returnfiles, @files);
+ TLUtils::push_uniq(\@returnfiles, @files);
}
}
}
@@ -270,12 +260,12 @@ sub files_under_path {
my $p = shift;
my @files = ();
foreach my $aa (@{$self->{'_filesofdir'}{$p}}) {
- push_uniq( \@files, $p . "/" . $aa);
+ TLUtils::push_uniq(\@files, $p . "/" . $aa);
}
if (defined($self->{'_subdirsofdir'}{$p})) {
foreach my $sd (@{$self->{'_subdirsofdir'}{$p}}) {
my @sdf = $self->files_under_path($p . "/" . $sd);
- push_uniq (\@files, @sdf);
+ TLUtils::push_uniq (\@files, @sdf);
}
}
return @files;
diff --git a/new-infra/TLUtils.pm b/new-infra/TLUtils.pm
new file mode 100644
index 00000000000..9589d200cec
--- /dev/null
+++ b/new-infra/TLUtils.pm
@@ -0,0 +1,73 @@
+#
+# TLUtils.pm
+# common functions for TeX Live Infrastructure
+# Copyright 2007 Norbert Preining
+#
+# based on Fabrice Popineau's FileUtils.pm
+#
+# This file is licensed under the GNU General Public Licence version 2
+# or any later version
+
+package TLUtils;
+
+use File::Basename;
+
+BEGIN {
+ use Exporter ();
+ use Cwd;
+ use File::Path;
+ use vars qw( @ISA @EXPORT_OK );
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ &sort_uniq
+ &push_uniq
+ );
+}
+
+sub sort_uniq {
+ my (@l) = @_;
+ my ($e, $f, @r);
+ $f = "";
+ @l = sort(@l);
+ foreach $e (@l) {
+ if ($e ne $f) {
+ $f = $e;
+ push @r, $e;
+ }
+ }
+ return @r;
+}
+
+sub push_uniq {
+ local (*l, @le) = @_;
+ my ($e);
+ foreach $e (@le) {
+ if (! &member($e, @l)) {
+ push @l, $e;
+ }
+ }
+}
+
+sub member {
+ my ($e, @l) = @_;
+ my ($f);
+ foreach $f (@l) {
+ if ($e eq $f) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub debug {
+ print @_ if ($::opt_debug);
+}
+
+1;
+
+### Local Variables:
+### perl-indent-level: 4
+### tab-width: 4
+### indent-tabs-mode: t
+### End:
+# vim:set tabstop=4: #
diff --git a/new-infra/TODO b/new-infra/TODO
index c4858c43f84..8c073b618bd 100644
--- a/new-infra/TODO
+++ b/new-infra/TODO
@@ -1,8 +1,4 @@
TODO for new-infra
==================
-- move several functions from TLTREE to a module TLUtils (push_uniq etc)
-- use push_uniq in TLP.pm add_files ... we have multiple occurrences of files
-- TLP.pm: make_zip function
- update.pl: implement more of the 'updater'
- ...
-
diff --git a/new-infra/etc/create-tlsrc-from-tpm.pl b/new-infra/etc/create-tlsrc-from-tpm.pl
index ca842a5892f..bbb76137c28 100755
--- a/new-infra/etc/create-tlsrc-from-tpm.pl
+++ b/new-infra/etc/create-tlsrc-from-tpm.pl
@@ -15,7 +15,6 @@ no strict 'refs';
# no warnings 'uninitialized';
my $opt_master;
-our $opt_debug;
our $opt_nosrcpkg;
our $opt_noremove;
my $globalreclevel;
@@ -35,7 +34,7 @@ if (!($mydir =~ m,/.*,,)) { $mmydir = `pwd`; chomp($mmydir); $mydir = "$mmydir/$
# $opt_master = "./LocalTPM";
-$opt_debug = 0;
+my $opt_debug = 0;
$opt_nosrcpkg = 0;
$opt_noremove = 0;
$globalreclevel = 1;
@@ -72,7 +71,6 @@ my $allowed_dists = "(unstable|UNRELEASED|sarge-backports|etch-backports|stable-
our $Master;
-our %TpmData;
$Master = `pwd`;
chomp($Master);
@@ -104,7 +102,6 @@ our %TypeOfTexmfTree = reverse %TexmfTreeOfType;
# this is set in the main script, and changed with commandline option.
# should it maybe be deleted here?
-my $opt_debug;
my $opt_onlyscripts;
sub populate_TpmData_from_dump {
@@ -194,6 +191,10 @@ sub load_collection_tpm_data {
$shortn =~ s,\.tpm$,,;
if (($t eq 'TLCore') && ($shortn =~ m/^scheme-/)) { next ; }
my $tpm = Tpm->new("$subtree/tpm/$shortn.tpm");
+ $TpmData{$t}{$shortn}{'BinPatterns'} = [ $tpm->getList("BinPatterns") ];
+ $TpmData{$t}{$shortn}{'DocPatterns'} = [ $tpm->getList("DocPatterns") ];
+ $TpmData{$t}{$shortn}{'RunPatterns'} = [ $tpm->getList("RunPatterns") ];
+ $TpmData{$t}{$shortn}{'SourcePatterns'} = [ $tpm->getList("SourcePatterns") ];
$TpmData{$t}{$shortn}{'BinFiles'} = [ $tpm->getFileList("BinFiles") ];
$TpmData{$t}{$shortn}{'DocFiles'} = [ $tpm->getFileList("DocFiles") ];
$TpmData{$t}{$shortn}{'RunFiles'} = [ $tpm->getFileList("RunFiles") ];
@@ -218,6 +219,40 @@ sub load_collection_tpm_data {
sub create_tlsrc_files {
print "Creating tlsrc files TpmData\n\n";
#foreach my $t ('TLCore', 'Documentation', 'Package') {
+ foreach my $t ('TLCore') {
+ print "Creating tlsrc for $t:\n";
+ my %foo = %{$TpmData{$t}};
+ foreach my $p (keys %foo) {
+ open (FOO,">tlsrc/$p.tlsrc") || die("Cannot open tlsrc/$p.tlsrc!");
+ print FOO "name $p\n";
+ print FOO "shortdesc $TpmData{$t}{$p}{'Title'}\n";
+ print FOO "longdesc $TpmData{$t}{$p}{'Description'}\n";
+ foreach my $foo (@{$TpmData{$t}{$p}{'Package'}}) {
+ print FOO "depend $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'TLCore'}}) {
+ print FOO "depend $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'SourcePatterns'}}) {
+ print FOO "SourcePatterns $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'BinPatterns'}}) {
+ print FOO "binpatterns $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'DocPatterns'}}) {
+ print FOO "docpatterns $foo\n";
+ }
+ foreach my $foo (@{$TpmData{$t}{$p}{'RunPatterns'}}) {
+ print FOO "runpatterns $foo\n";
+ }
+ foreach my $ex (@{$TpmData{$t}{$p}{'Installation'}}) {
+ my %foo = %{$ex};
+ print FOO "execute $foo{'function'} $foo{'mode'} $foo{'parameter'}\n";
+ }
+ close(FOO);
+ }
+ }
+ return (0);
foreach my $t ('Package') {
print "Creating tlsrc for $t:\n";
my %foo = %{$TpmData{$t}};
diff --git a/new-infra/specification.txt b/new-infra/specification.txt
index 56dc91ae8dc..edce99a97c2 100644
--- a/new-infra/specification.txt
+++ b/new-infra/specification.txt
@@ -1,8 +1,6 @@
Specifications
==============
-(I opt AGAINST @foobar, this makes perl code much more complicate!)
-
1) tlsrc
--------
one file *WITHOUT* empty lines (but beginning and end)
@@ -38,9 +36,9 @@ catalogue
word1/.../wordN/.../wordL/...
(cheap)
f string
- include file "string"
- (should we add glob expansion?)
- (cheap, with glob I don't know)
+ include file "string" where the LAST(!!!) entry (basename)
+ of string can contain glob characters * and ? (but no other!)
+ (cheap)
d string
include all files in and below the directory "string"
(cheap)
diff --git a/new-infra/test-tldb.pl b/new-infra/test-tldb.pl
index 373058a6459..9e7ed4b6458 100644
--- a/new-infra/test-tldb.pl
+++ b/new-infra/test-tldb.pl
@@ -2,26 +2,30 @@
use strict;
+use TLSRC;
use TLP;
use TLDB;
+use TLTREE;
-my $tldb = new TLDB;
+#our $opt_debug=1;
-my $tlp = new TLP;
-$tlp->from_file("tlp/baz.tlp");
-$tldb->add_tlp($tlp);
+my $tldb = new TLDB;
+my $tltree = TLTREE->new( 'svnroot' => "/src/TeX/texlive-svn/new-infra" );
+$tltree->init_from_svn;
-$tlp = new TLP;
-$tlp->from_file("tlp/foo.tlp");
-$tldb->add_tlp($tlp);
+foreach my $f (@ARGV) {
+ my $tlsrc = new TLSRC;
+ $tlsrc->from_file($f);
+ my $tlp = $tlsrc->make_tlp($tltree);
+ $tldb->add_tlp($tlp);
+}
-open(TMP,">test.tldb");
-$tldb->writeout(\*TMP);
-close(TMP);
-$tldb->writeout;
+$tldb->location("test.tldb");
+$tldb->save;
print "=========================\n";
my $tldbnew = new TLDB;
-$tldb->from_file("test.tldb");
-$tldb->writeout;
+$tldbnew->from_file("test.tldb");
+$tldbnew->writeout;
+
diff --git a/new-infra/test-tlp2.pl b/new-infra/test-tlp2.pl
new file mode 100644
index 00000000000..7b58b792fc7
--- /dev/null
+++ b/new-infra/test-tlp2.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl -w
+
+use strict;
+
+use TLSRC;
+use TLP;
+use TLTREE;
+use Data::Dumper;
+
+#our $opt_debug = 1;
+
+my $tltree = TLTREE->new( 'svnroot' => "/src/TeX/texlive-svn/new-infra" );
+$tltree->init_from_svn;
+
+foreach my $f (@ARGV) {
+ my $tlsrc = new TLSRC;
+ $tlsrc->from_file($f);
+ my $tlp = $tlsrc->make_tlp($tltree);
+ my $name = $tlp->name;
+ open(FOO,">tlp/$name.tlp");
+ $tlp->writeout(\*FOO);
+ close(FOO);
+ $tlp->make_zip($tltree,"./zip"); # name absent, use the name of the tlp
+}
+
+
diff --git a/new-infra/test-tltree.pl b/new-infra/test-tltree.pl
index 657516b8568..5cb4fead021 100644
--- a/new-infra/test-tltree.pl
+++ b/new-infra/test-tltree.pl
@@ -1,7 +1,11 @@
#!/usr/bin/perl -w
+use lib '/src/TeX/texlive-svn/new-infra';
+
use strict;
+our $opt_debug=1;
+
use TLTREE;
use Data::Dumper;
@@ -32,3 +36,6 @@ foreach (keys %$foo) {
print "arch=$_: @a\n";
}
+
+$foo = $tl->get_matching_files('run','f texmf-dist/fonts/tfm/bar/file?');
+print "file matching g texmf-dist/fonts/tfm/bar/file?: @$foo\n";
diff --git a/new-infra/tlsrc/bar.tlsrc b/new-infra/tlsrc/bar.tlsrc
index 4645a92f0c1..db471ff6642 100644
--- a/new-infra/tlsrc/bar.tlsrc
+++ b/new-infra/tlsrc/bar.tlsrc
@@ -12,4 +12,3 @@ depend another collection
depend foo
runpatterns t texmf-dist bar
docpatterns r texmf/.*/bar/.*
-binpatterns t bin ${ARCH}