diff options
author | Norbert Preining <preining@logic.at> | 2007-06-02 17:49:14 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-06-02 17:49:14 +0000 |
commit | 4dc41c7ce0ba9d2d0f679d1d6825b5b29a4ccb35 (patch) | |
tree | ef81201ea064cc9d5c37e590b8ad9fa2e4e2910c | |
parent | 071ffccada1a34c3aa94fe1e5bfb0354a742d699 (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.txt | 36 | ||||
-rw-r--r-- | new-infra/TLDB.pm | 25 | ||||
-rw-r--r-- | new-infra/TLP.pm | 110 | ||||
-rw-r--r-- | new-infra/TLTREE.pm | 92 | ||||
-rw-r--r-- | new-infra/TLUtils.pm | 73 | ||||
-rw-r--r-- | new-infra/TODO | 4 | ||||
-rwxr-xr-x | new-infra/etc/create-tlsrc-from-tpm.pl | 43 | ||||
-rw-r--r-- | new-infra/specification.txt | 8 | ||||
-rw-r--r-- | new-infra/test-tldb.pl | 30 | ||||
-rw-r--r-- | new-infra/test-tlp2.pl | 26 | ||||
-rw-r--r-- | new-infra/test-tltree.pl | 7 | ||||
-rw-r--r-- | new-infra/tlsrc/bar.tlsrc | 1 |
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} |