diff options
author | Norbert Preining <preining@logic.at> | 2007-06-18 14:23:18 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-06-18 14:23:18 +0000 |
commit | dfd6e494fcfcfe684312b959c68d589b06d33594 (patch) | |
tree | 9d14cbe7b574ddcb88afbc910ab89a4af4c7f7cf /Master/tlpkg/TeXLive | |
parent | 7fb60a74aab3febff8b73f2c8485f038d6a5e8cf (diff) |
it is tlpsrc not tlsrc, tlpobj not tlp, tlpdb not tldb...
git-svn-id: svn://tug.org/texlive/trunk@4469 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 387 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 924 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 670 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLTREE.pm | 437 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 96 |
5 files changed, 1245 insertions, 1269 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 1f5b79612cb..e36f6d758e2 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -1,6 +1,6 @@ # # TeXLive::TLPDB.pm -# module for using tldb files +# module for using tlpdb files # Copyright 2007 Norbert Preining # # This file is licensed under the GNU General Public Licence version 2 @@ -15,19 +15,19 @@ TeXLive::TLPDB - a database of TeX Live Packages =head1 SYNOPSIS - use TeXLive::TLPDB; + use TeXLive::TLPDB; - TeXLive::TLPDB->listdir([$dir]); - TeXLive::TLPDB->new ( [ location => "path/to/tldb/file" ] ); + TeXLive::TLPDB->listdir([$dir]); + TeXLive::TLPDB->new ( [ location => "path/to/tlpdb/file" ] ); - $tlpdb->location([$location]); - $tlpdb->from_file($filename); - $tlpdb->writeout([FILEHANDLE]); - $tlpdb->save; - $tlpdb->generate_listfiles([$destdir]); - $tlpdb->add_objpkg($tlpobj); - $tlpdb->get_package("packagename"); - $tlpdb->package_revision("packagename"); + $tlpdb->location([$location]); + $tlpdb->from_file($filename); + $tlpdb->writeout([FILEHANDLE]); + $tlpdb->save; + $tlpdb->generate_listfiles([$destdir]); + $tlpdb->add_objpkg($tlpobj); + $tlpdb->get_package("packagename"); + $tlpdb->package_revision("packagename"); =head1 DESCRIPTION @@ -46,18 +46,18 @@ location is given it will be initialized from this locations. =cut sub new { - my $class = shift; - my %params = @_; - my $self = { - location => $params{'location'}, - tlps => $params{'tlps'} - }; - $_listdir = $params{'listdir'} if defined($params{'listdir'}); - bless $self, $class; - if (defined($self->{'location'})) { - $self->from_file($self->{'location'}); - } - return $self; + my $class = shift; + my %params = @_; + my $self = { + location => $params{'location'}, + tlps => $params{'tlps'} + }; + $_listdir = $params{'listdir'} if defined($params{'listdir'}); + bless $self, $class; + if (defined($self->{'location'})) { + $self->from_file($self->{'location'}); + } + return $self; } =pod @@ -66,8 +66,8 @@ The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB. =cut sub add_tlpobj { - my ($self,$tlp) = @_; - $self->{'tlps'}{$tlp->name} = $tlp; + my ($self,$tlp) = @_; + $self->{'tlps'}{$tlp->name} = $tlp; } =pod @@ -77,26 +77,26 @@ was not given at generation time. =cut sub from_file { - my $self = shift; - if (@_ != 1) { - die("Need a filename for initialization!"); - } - if (defined($self->{'location'})) { - if ($self->location ne $_[0]) { - printf STDERR "Initialisation from different location as originally given.\nHope you are sure!\n"; - } - } - $self->location($_[0]); - open(TMP,"<$_[0]") || die("Cannot open tldb file: $_[0]"); - my $found = 0; - do { - my $tlp = TeXLive::TLPOBJ->new; - &TeXLive::TLUtils::debug("creating tlp ...\n"); - $found = $tlp->from_fh(\*TMP,1); - if ($found) { - $self->add_tlpobj($tlp); - } - } until (!$found); + my $self = shift; + if (@_ != 1) { + die("Need a filename for initialization!"); + } + if (defined($self->{'location'})) { + if ($self->location ne $_[0]) { + printf STDERR "Initialisation from different location as originally given.\nHope you are sure!\n"; + } + } + $self->location($_[0]); + open(TMP,"<$_[0]") || die("Cannot open tlpdb file: $_[0]"); + my $found = 0; + do { + my $tlp = TeXLive::TLPOBJ->new; + &TeXLive::TLUtils::debug("creating tlp ...\n"); + $found = $tlp->from_fh(\*TMP,1); + if ($found) { + $self->add_tlpobj($tlp); + } + } until (!$found); } =pod @@ -106,14 +106,14 @@ handle given as argument. =cut sub writeout { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - foreach (sort keys %{$self->{'tlps'}}) { - &TeXLive::TLUtils::debug("tlpname = $_\n"); - &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name . "\n"); - $self->{'tlps'}{$_}->writeout($fd); - print $fd "\n"; - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + foreach (sort keys %{$self->{'tlps'}}) { + &TeXLive::TLUtils::debug("tlpname = $_\n"); + &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name . "\n"); + $self->{'tlps'}{$_}->writeout($fd); + print $fd "\n"; + } } =pod @@ -123,10 +123,10 @@ as location. If the location is undefined, die. =cut sub save { - my $self = shift; - open(FOO,">$self->{'location'}") || die("Cannot open $self->{'location'} for writing: $!"); - $self->writeout(\*FOO); - close(FOO); + my $self = shift; + open(FOO,">$self->{'location'}") || die("Cannot open $self->{'location'} for writing: $!"); + $self->writeout(\*FOO); + close(FOO); } =pod @@ -136,12 +136,12 @@ its name the the argument name coincide. =cut sub get_package { - my ($self,$pkg) = @_; - if (defined($self->{'tlps'}{$pkg})) { - return($self->{'tlps'}{$pkg}); - } else { - return(undef); - } + my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + return($self->{'tlps'}{$pkg}); + } else { + return(undef); + } } =pod @@ -151,12 +151,12 @@ package named in the first argument. =cut sub package_revision { - my ($self,$pkg) = @_; - if (defined($self->{'tlps'}{$pkg})) { - return($self->{'tlps'}{$pkg}->revision); - } else { - return(undef); - } + my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + return($self->{'tlps'}{$pkg}->revision); + } else { + return(undef); + } } =pod @@ -166,11 +166,11 @@ with their revisions. =cut sub generate_packagelist { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - foreach (sort keys %{$self->{'tlps'}}) { - print $fd $self->{'tlps'}{$_}->name, " ", $self->{'tlps'}{$_}->revision, "\n"; - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + foreach (sort keys %{$self->{'tlps'}}) { + print $fd $self->{'tlps'}{$_}->name, " ", $self->{'tlps'}{$_}->revision, "\n"; + } } =pod @@ -180,117 +180,122 @@ installers. This function will probably go away. =cut sub generate_listfiles { - my ($self,$destdir) = @_; - if (not(defined($destdir))) { - $destdir = TeXLive::TLPDB->listdir; - } - foreach (sort keys %{$self->{'tlps'}}) { - $tlp = $self->{'tlps'}{$_}; - $self->_generate_listfile($tlp, $destdir, "all"); - if ($tlp->is_arch_dependent) { - foreach my $a (keys %{$tlp->binfiles}) { - $self->_generate_listfile($tlp, $destdir, $a); - } - } - } + my ($self,$destdir) = @_; + if (not(defined($destdir))) { + $destdir = TeXLive::TLPDB->listdir; + } + foreach (sort keys %{$self->{'tlps'}}) { + $tlp = $self->{'tlps'}{$_}; + $self->_generate_listfile($tlp, $destdir, "all"); + if ($tlp->is_arch_dependent) { + foreach my $a (keys %{$tlp->binfiles}) { + $self->_generate_listfile($tlp, $destdir, $a); + } + } + } } sub _generate_listfile { - my ($self,$tlp,$destdir,$arch) = @_; - my @files = (); - my $listname; - if ($arch ne "all") { - my %foo = %{$tlp->binfiles}; - push @files, @{$foo{$arch}}; - $listname = $tlp->name . ".$arch"; - } else { - $listname = $tlp->name; - push @files, $tlp->runfiles; - push @files, $tlp->docfiles; - push @files, $tlp->srcfiles; - } - @files = TeXLive::TLUtils::sort_uniq(@files); - &mkpath("$destdir") if (! -d "$destdir"); - my (@lop, @lot); - foreach my $d ($tlp->depends) { - if ($d =~ m/^(Package|Documentation)\/(.*)$/) { - push @lop, $2; - } elsif ($d =~ m/^TLCore\/(.*)$/) { - push @lot, $1; - } else { - warn "strange depends line: $d\n"; - } - } - open(TMP, ">$destdir/$listname") or die "Cannot open $destdir/$listname!"; - # title and size information for collections and schemes in the - # first two lines, marked with * - if ($listname =~ m/^collection-/) { - print TMP "*Title: ", $tlp->shortdesc, "\n"; - # collections references Packages, we have to collect the sizes of - # all the Package-tlps included - # What is unclear for me is HOW the size is computed for bin-* - # packages. The collection-basicbin contains quite a lot of - # bin-files, but the sizes for the different archs differ. - # I guess we have to take the maximum? - my $s = 0; - foreach my $p (@lop) { - my $subtlp = $self->get_package($p); - if (!defined($subtlp)) { - warn "Strange: $listname references $p, but it is not in tldb"; + my ($self,$tlp,$destdir,$arch) = @_; + my @files = (); + my $listname; + if ($arch ne "all") { + my %foo = %{$tlp->binfiles}; + push @files, @{$foo{$arch}}; + $listname = $tlp->name . ".$arch"; + } else { + $listname = $tlp->name; + push @files, $tlp->runfiles; + push @files, $tlp->docfiles; + push @files, $tlp->srcfiles; + } + @files = TeXLive::TLUtils::sort_uniq(@files); + &mkpath("$destdir") if (! -d "$destdir"); + my (@lop, @lot); + foreach my $d ($tlp->depends) { + if ($d =~ m/^(Package|Documentation|TLCore)\/(.*)$/) { + push @lop, $2; + } elsif ($d =~ m/^Collection\/(.*)$/) { + push @lot, $1; + } else { + warn "strange depends line: $d\n"; + } + } + open(TMP, ">$destdir/$listname") or die "Cannot open $destdir/$listname!"; + # title and size information for collections and schemes in the + # first two lines, marked with * + if ($tlp->category eq "Collection") { + print TMP "*Title: ", $tlp->shortdesc, "\n"; + # collections references Packages, we have to collect the sizes of + # all the Package-tlps included + # What is unclear for me is HOW the size is computed for bin-* + # packages. The collection-basicbin contains quite a lot of + # bin-files, but the sizes for the different archs differ. + # I guess we have to take the maximum? + my $s = 0; + foreach my $p (@lop) { + my $subtlp = $self->get_package($p); + if (!defined($subtlp)) { + warn "Strange: $listname references $p, but it is not in tlpdb"; + } + $s += $subtlp->total_size; + } + # in case the collection itself ships files ... + $s += $tlp->runsize + $tlp->srcsize + $tlp->docsize; + print TMP "*Size: $s\n"; + } elsif ($tlp->category eq "Scheme") { + print TMP "*Title: ", $tlp->shortdesc, "\n"; + my $s = 0; + # schemes size includes ONLY those packages which are directly + # included and direclty included files, not the size of the + # included collections. But if a package is included in one of + # the called for collections AND listed directly, we don't want + # to count its size two times + my (@inccol,@incpkg,@collpkg); + # first we add all the packages tlps that are directly included + @incpkg = @lop; + # now we select all collections, and for all collections we + # again select all packages of type Documentation and Package + foreach my $c (@lot) { + my $coll = $self->get_package($c); + foreach my $d ($coll->depends) { + if ($d =~ m/^(Package|Documentation|TLCore)\/(.*)$/) { + TeXLive::TLUtils::push_uniq(\@collpkg,$2); + } + } + } + # finally go through all packages and add the ->total_size + foreach my $p (@incpkg) { + if (!TeXLive::TLUtils::member($p,@collpkg)) { + $s += $self->get_package($p)->total_size; } - $s += $subtlp->total_size; - } - # in case the collection itself ships files ... + } $s += $tlp->runsize + $tlp->srcsize + $tlp->docsize; - print TMP "*Size: $s\n"; - } elsif ($listname =~ m/^scheme-/) { - print TMP "*Title: ", $tlp->shortdesc, "\n"; - my $s = 0; - # needs a bitof trickyness, because contained collections - # do not have intersections of packages, but there could be - # additional tlps included which would be doubly included - my (@inccol,@incpkg); - # first we add all the packages tlps that are directly included - @incpkg = @lop; - # now we select all collections, and for all collections we - # again select all packages of type Documentation and Package - foreach my $c (@lot) { - my $coll = $self->get_package($c); - foreach my $d ($coll->depends) { - if ($d =~ m/^(Package|Documentation)\/(.*)$/) { - TeXLive::TLUtils::push_uniq(\@incpkg,$2); - } - } - } - # finally go through all packages and add the ->total_size - foreach my $p (@incpkg) { - $s += $self->get_package($p)->total_size - } - print TMP "*Size: $s\n"; - } - # dependencies and inclusion of packages - foreach my $t (@lot) { - # strange, schemes mark included collections via -, while collections - # themself mark deps on other collections with +. collection are - # never referenced in Packages - if ($listname =~ m/^scheme/) { - print TMP "-"; - } else { - print TMP "+"; - } - print TMP "$t\n"; - } - foreach my $t (@lop) { print TMP "+$t\n"; } - # included files - foreach my $f (@files) { print TMP "$f\n"; } - # also print the listfile itself - print TMP "$destdir/$listname\n"; - # execute statements - foreach my $e ($tlp->executes) { - print TMP "!$e\n"; - } - # finish - close(TMP); + print TMP "*Size: $s\n"; + } + # dependencies and inclusion of packages + foreach my $t (@lot) { + # strange, schemes mark included collections via -, while collections + # themself mark deps on other collections with +. collection are + # never referenced in Packages + if ($listname =~ m/^scheme/) { + print TMP "-"; + } else { + print TMP "+"; + } + print TMP "$t\n"; + } + foreach my $t (@lop) { print TMP "+$t\n"; } + # included files + foreach my $f (@files) { print TMP "$f\n"; } + # also print the listfile itself + print TMP "$destdir/$listname\n"; + # execute statements + foreach my $e ($tlp->executes) { + print TMP "!$e\n"; + } + # finish + close(TMP); } =pod @@ -300,9 +305,9 @@ text file of the TeX Live Database. =cut sub location { - my $self = shift; - if (@_) { $self->{'location'} = shift } - return $self->{'location'}; + my $self = shift; + if (@_) { $self->{'location'} = shift } + return $self->{'location'}; } =pod @@ -312,9 +317,9 @@ specifiying where generated list files are created. =cut sub listdir { - my @self = shift; - if (@_) { $_listdir = $_[0] } - return $_listdir; + my @self = shift; + if (@_) { $_listdir = $_[0] } + return $_listdir; } @@ -339,8 +344,8 @@ repository trunk/Master/tlpkg/doc/. 1; ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index fa80650a973..b5d4a3a6e2e 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -1,6 +1,6 @@ # # TeXLive::TLPOBJ.pm -# module for using tlp files +# module for using tlpobj files # Copyright 2007 Norbert Preining # # This file is licensed under the GNU General Public Licence version 2 @@ -18,556 +18,556 @@ my $_tmp; my $_zipdir; sub new { - my $class = shift; - my %params = @_; - my $self = { - name => $params{'name'}, - category => defined($params{'category'}) ? $params{'category'} : "Package", - shortdesc => $params{'shortdesc'}, - longdesc => $params{'longdesc'}, - catalogue => $params{'catalogue'}, - runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [], - runsize => $params{'runsize'}, - srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [], - srcsize => $params{'srcsize'}, - docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [], - docsize => $params{'docsize'}, - executes => defined($params{'executes'}) ? $params{'executes'} : [], - # note that binfiles is an ARRAY with keys of $arch! - binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {}, - binsize => defined($params{'binsize'}) ? $params{'binsize'} : {}, - depends => defined($params{'depends'}) ? $params{'depends'} : [], - revision => $params{'revision'}, - }; - $_zipdir = $params{'zipdir'} if defined($params{'zipdir'}); - bless $self, $class; - return $self; + my $class = shift; + my %params = @_; + my $self = { + name => $params{'name'}, + category => defined($params{'category'}) ? $params{'category'} : "Package", + shortdesc => $params{'shortdesc'}, + longdesc => $params{'longdesc'}, + catalogue => $params{'catalogue'}, + runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [], + runsize => $params{'runsize'}, + srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [], + srcsize => $params{'srcsize'}, + docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [], + docsize => $params{'docsize'}, + executes => defined($params{'executes'}) ? $params{'executes'} : [], + # note that binfiles is an ARRAY with keys of $arch! + binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {}, + binsize => defined($params{'binsize'}) ? $params{'binsize'} : {}, + depends => defined($params{'depends'}) ? $params{'depends'} : [], + revision => $params{'revision'}, + }; + $_zipdir = $params{'zipdir'} if defined($params{'zipdir'}); + bless $self, $class; + return $self; } sub from_file { - my $self = shift; - if (@_ != 1) { - die("Need a filename for initialization!"); - } - open(TMP,"<$_[0]") || die("Cannot open tlp file: $_[0]"); - $self->from_fh(\*TMP); -} - + my $self = shift; + if (@_ != 1) { + die("Need a filename for initialization!"); + } + open(TMP,"<$_[0]") || die("Cannot open tlpobj file: $_[0]"); + $self->from_fh(\*TMP); +} + sub from_fh { - my ($self,$fh,$multi) = @_; - my $started = 0; - my $lastcmd = ""; - my $arch; - my $size; + my ($self,$fh,$multi) = @_; + my $started = 0; + my $lastcmd = ""; + my $arch; + my $size; - while (my $line = $fh->getline) { - &TeXLive::TLUtils::debug("reading line: >>>$line<<<\n"); - &TeXLive::TLUtils::debug("multi=...$multi...\n"); - $line =~ /^\s*#/ && next; # skip comment lines - if ($line =~ /^\s*$/) { - if (!$started) { next; } - if (defined($multi)) { - # we may read from a tldb file - return 1; - } else { - # we are reading one tldb file, nothing else allowed - die("No empty line allowed within tlp files!"); - } - } - if ($line =~ /^ /) { - if ( ($lastcmd eq "longdesc") || - ($lastcmd eq "runfiles") || - ($lastcmd eq "binfiles") || - ($lastcmd eq "docfiles") || - ($lastcmd eq "srcfiles") || - ($lastcmd eq "executes") || - ($lastcmd eq "depend") ) { - $line =~ s/^ /${lastcmd}continued /; - } else { - die("Continuation of $lastcmd not allowed, please fix tlp!\n"); - } - } - if ($line =~ /^name\s*([-\w]+)$/) { - $name = "$1"; - $lastcmd = "name"; - $self->name("$name"); - $started && die("Cannot have two name directives: $line!"); - $started = 1; - } else { - $started || die("First directive needs to be 'name'"); - if ($line =~ /^shortdesc\s+(.*)$/) { - $self->{'shortdesc'} .= "$1"; - $lastcmd = "shortdesc"; - next; - } elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) { - if (defined($1) && ("$1" eq "continued")) { - $self->{'longdesc'} .= " $2"; - } else { - $self->{'longdesc'} = "$2"; - } - $lastcmd = "longdesc"; - next; - } elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) { - $self->{'category'} = "$1"; - $lastcmd = "category"; - next; - } elsif ($line =~ /^revision\s+(.*)$/) { - $self->{'revision'} = "$1"; - $lastcmd = "revision"; - next; - } elsif ($line =~ /^catalogue\s+(.*)$/) { - $self->catalogue("$1"); - $lastcmd = "catalogue"; - next; - } elsif ($line =~ /^(doc|src|run)files\s+/) { - my $type = $1; - my @words = split ' ',$line; - # first entry is "XXXfiles", shift it away - $lastcmd = shift @words; - while (@words) { - $_ = shift @words; - if (/^size=(.*)$/) { - $size=$1; - } else { - die "Unknown tag: $line"; - } - } - if (defined($size)) { - $self->{"${type}size"} = $size; - } - next; - } elsif ($line =~ /^(doc|src|run)filescontinued\s+(.*)$/) { - push @{$self->{$1."files"}}, "$2"; - next; - } elsif ($line =~ /^binfiles\s+/) { - my @words = split ' ',$line; - # first entry is "binfiles", shift it away - shift @words; - while (@words) { - $_ = shift @words; - if (/^arch=(.*)$/) { - $arch=$1; - } elsif (/^size=(.*)$/) { - $size=$1; - } else { - die "Unknown tag: $line"; - } - } - if (defined($size)) { - $self->{'binsize'}{$arch} = $size; - } - $lastcmd = "binfiles"; - next; - } elsif ($line =~ /^binfilescontinued\s+(.*)$/) { - push @{$self->{'binfiles'}{$arch}}, "$1"; - next; - } elsif ($line =~ /^execute(continued)?\s*(.*)$/) { - push @{$self->{'executes'}}, "$2" unless "$2" eq ""; - $lastcmd = "execute"; - next; - } elsif ($line =~ /^depend(continued)?\s*(.*)$/) { - push @{$self->{'depends'}}, "$2" unless "$2" eq ""; - $lastcmd = "depend"; - next; - } else { - die("Unknown directive ...$line... , please fix it!"); - } - } - } - return $started; + while (my $line = $fh->getline) { + &TeXLive::TLUtils::debug("reading line: >>>$line<<<\n"); + &TeXLive::TLUtils::debug("multi=...$multi...\n"); + $line =~ /^\s*#/ && next; # skip comment lines + if ($line =~ /^\s*$/) { + if (!$started) { next; } + if (defined($multi)) { + # we may read from a tldb file + return 1; + } else { + # we are reading one tldb file, nothing else allowed + die("No empty line allowed within tlpobj files!"); + } + } + if ($line =~ /^ /) { + if ( ($lastcmd eq "longdesc") || + ($lastcmd eq "runfiles") || + ($lastcmd eq "binfiles") || + ($lastcmd eq "docfiles") || + ($lastcmd eq "srcfiles") || + ($lastcmd eq "executes") || + ($lastcmd eq "depend") ) { + $line =~ s/^ /${lastcmd}continued /; + } else { + die("Continuation of $lastcmd not allowed, please fix tlpobj!\n"); + } + } + if ($line =~ /^name\s*([-\w]+)$/) { + $name = "$1"; + $lastcmd = "name"; + $self->name("$name"); + $started && die("Cannot have two name directives: $line!"); + $started = 1; + } else { + $started || die("First directive needs to be 'name'"); + if ($line =~ /^shortdesc\s+(.*)$/) { + $self->{'shortdesc'} .= "$1"; + $lastcmd = "shortdesc"; + next; + } elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) { + if (defined($1) && ("$1" eq "continued")) { + $self->{'longdesc'} .= " $2"; + } else { + $self->{'longdesc'} = "$2"; + } + $lastcmd = "longdesc"; + next; + } elsif ($line =~ /^category\s+(Scheme|Collection|Package|TLCore|Documentation)$/) { + $self->{'category'} = "$1"; + $lastcmd = "category"; + next; + } elsif ($line =~ /^revision\s+(.*)$/) { + $self->{'revision'} = "$1"; + $lastcmd = "revision"; + next; + } elsif ($line =~ /^catalogue\s+(.*)$/) { + $self->catalogue("$1"); + $lastcmd = "catalogue"; + next; + } elsif ($line =~ /^(doc|src|run)files\s+/) { + my $type = $1; + my @words = split ' ',$line; + # first entry is "XXXfiles", shift it away + $lastcmd = shift @words; + while (@words) { + $_ = shift @words; + if (/^size=(.*)$/) { + $size=$1; + } else { + die "Unknown tag: $line"; + } + } + if (defined($size)) { + $self->{"${type}size"} = $size; + } + next; + } elsif ($line =~ /^(doc|src|run)filescontinued\s+(.*)$/) { + push @{$self->{$1."files"}}, "$2"; + next; + } elsif ($line =~ /^binfiles\s+/) { + my @words = split ' ',$line; + # first entry is "binfiles", shift it away + shift @words; + while (@words) { + $_ = shift @words; + if (/^arch=(.*)$/) { + $arch=$1; + } elsif (/^size=(.*)$/) { + $size=$1; + } else { + die "Unknown tag: $line"; + } + } + if (defined($size)) { + $self->{'binsize'}{$arch} = $size; + } + $lastcmd = "binfiles"; + next; + } elsif ($line =~ /^binfilescontinued\s+(.*)$/) { + push @{$self->{'binfiles'}{$arch}}, "$1"; + next; + } elsif ($line =~ /^execute(continued)?\s*(.*)$/) { + push @{$self->{'executes'}}, "$2" unless "$2" eq ""; + $lastcmd = "execute"; + next; + } elsif ($line =~ /^depend(continued)?\s*(.*)$/) { + push @{$self->{'depends'}}, "$2" unless "$2" eq ""; + $lastcmd = "depend"; + next; + } else { + die("Unknown directive ...$line... , please fix it!"); + } + } + } + return $started; } sub recompute_revision { - my ($self,$tltree) = @_; - my @files; - foreach my $a (keys %{$self->{'binfiles'}}) { - push @files, @{$self->{'binfiles'}{$a}}; - } - push @files, $self->runfiles; - push @files, $self->docfiles; - push @files, $self->srcfiles; - $filemax = 0; - foreach my $f (@files) { - $filemax = $tltree->file_svn_lastrevision($f); - $self->revision(($filemax > $self->revision) ? $filemax : $self->revision); - } + my ($self,$tltree) = @_; + my @files; + foreach my $a (keys %{$self->{'binfiles'}}) { + push @files, @{$self->{'binfiles'}{$a}}; + } + push @files, $self->runfiles; + push @files, $self->docfiles; + push @files, $self->srcfiles; + $filemax = 0; + foreach my $f (@files) { + $filemax = $tltree->file_svn_lastrevision($f); + $self->revision(($filemax > $self->revision) ? $filemax : $self->revision); + } } sub recompute_sizes { - my ($self,$tltree) = @_; - $self->{'docsize'} = $self->_recompute_size("doc",$tltree); - $self->{'srcsize'} = $self->_recompute_size("src",$tltree); - $self->{'runsize'} = $self->_recompute_size("run",$tltree); - foreach $a ($tltree->architectures) { - $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a); - } + my ($self,$tltree) = @_; + $self->{'docsize'} = $self->_recompute_size("doc",$tltree); + $self->{'srcsize'} = $self->_recompute_size("src",$tltree); + $self->{'runsize'} = $self->_recompute_size("run",$tltree); + foreach $a ($tltree->architectures) { + $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a); + } } sub _recompute_size { - my ($self,$type,$tltree,$arch) = @_; - my $size = 0; - if ($type eq "bin") { - my %binfiles = %{$self->{'binfiles'}}; - if (defined($binfiles{$arch})) { - foreach $f (@{$binfiles{$arch}}) { - $size += $tltree->size_of($f); - } - } - } else { - if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) { - foreach $f (@{$self->{"${type}files"}}) { - my $s = $tltree->size_of($f); - if (defined($s)) { - $size += $s; - } else { - printf STDERR "size for $f not defined, strange ...\n"; - } - } - } - } - return $size; + my ($self,$type,$tltree,$arch) = @_; + my $size = 0; + if ($type eq "bin") { + my %binfiles = %{$self->{'binfiles'}}; + if (defined($binfiles{$arch})) { + foreach $f (@{$binfiles{$arch}}) { + $size += $tltree->size_of($f); + } + } + } else { + if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) { + foreach $f (@{$self->{"${type}files"}}) { + my $s = $tltree->size_of($f); + if (defined($s)) { + $size += $s; + } else { + printf STDERR "size for $f not defined, strange ...\n"; + } + } + } + } + return $size; } sub writeout { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - format_name $fd "multilineformat"; - print $fd "name ", $self->name, "\n"; - print $fd "category ", $self->category, "\n"; - defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n"; - defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; - defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; - if (defined($self->{'longdesc'})) { - $_tmp = "longdesc $self->{'longdesc'}"; - write $fd; - } - if (defined($self->{'depends'})) { - foreach (@{$self->{'depends'}}) { - print $fd "depend $_\n"; - } - } - if (defined($self->{'executes'})) { - foreach (@{$self->{'executes'}}) { - print $fd "execute $_\n"; - } - } - if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { - print $fd "docfiles size=$self->{'docsize'}\n"; - foreach (sort @{$self->{'docfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { - print $fd "srcfiles size=$self->{'srcsize'}\n"; - foreach (sort @{$self->{'srcfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { - print $fd "runfiles size=$self->{'runsize'}\n"; - foreach (sort @{$self->{'runfiles'}}) { - print $fd " $_\n"; - } - } - foreach my $arch (keys %{$self->{'binfiles'}}) { - if (@{$self->{'binfiles'}{$arch}}) { - print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n"; - foreach (sort @{$self->{'binfiles'}{$arch}}) { - print $fd " $_\n"; - } - } - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + format_name $fd "multilineformat"; + print $fd "name ", $self->name, "\n"; + print $fd "category ", $self->category, "\n"; + defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n"; + defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; + defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; + if (defined($self->{'longdesc'})) { + $_tmp = "$self->{'longdesc'}"; + write $fd; + } + if (defined($self->{'depends'})) { + foreach (@{$self->{'depends'}}) { + print $fd "depend $_\n"; + } + } + if (defined($self->{'executes'})) { + foreach (@{$self->{'executes'}}) { + print $fd "execute $_\n"; + } + } + if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { + print $fd "docfiles size=$self->{'docsize'}\n"; + foreach (sort @{$self->{'docfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { + print $fd "srcfiles size=$self->{'srcsize'}\n"; + foreach (sort @{$self->{'srcfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { + print $fd "runfiles size=$self->{'runsize'}\n"; + foreach (sort @{$self->{'runfiles'}}) { + print $fd " $_\n"; + } + } + foreach my $arch (keys %{$self->{'binfiles'}}) { + if (@{$self->{'binfiles'}{$arch}}) { + print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n"; + foreach (sort @{$self->{'binfiles'}{$arch}}) { + print $fd " $_\n"; + } + } + } } sub writeout_simple { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - format_name $fd "multilineformat"; - print $fd "name ", $self->name, "\n"; - print $fd "category ", $self->category, "\n"; - if (defined($self->{'depends'})) { - foreach (@{$self->{'depends'}}) { - print $fd "depend $_\n"; - } - } - if (defined($self->{'executes'})) { - foreach (@{$self->{'executes'}}) { - print $fd "execute $_\n"; - } - } - if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { - print $fd "docfiles\n"; - foreach (sort @{$self->{'docfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { - print $fd "srcfiles\n"; - foreach (sort @{$self->{'srcfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { - print $fd "runfiles\n"; - foreach (sort @{$self->{'runfiles'}}) { - print $fd " $_\n"; - } - } - foreach my $arch (sort keys %{$self->{'binfiles'}}) { - if (@{$self->{'binfiles'}{$arch}}) { - print $fd "binfiles arch=$arch\n"; - foreach (sort @{$self->{'binfiles'}{$arch}}) { - print $fd " $_\n"; - } - } - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + format_name $fd "multilineformat"; + print $fd "name ", $self->name, "\n"; + print $fd "category ", $self->category, "\n"; + if (defined($self->{'depends'})) { + foreach (@{$self->{'depends'}}) { + print $fd "depend $_\n"; + } + } + if (defined($self->{'executes'})) { + foreach (@{$self->{'executes'}}) { + print $fd "execute $_\n"; + } + } + if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { + print $fd "docfiles\n"; + foreach (sort @{$self->{'docfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { + print $fd "srcfiles\n"; + foreach (sort @{$self->{'srcfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { + print $fd "runfiles\n"; + foreach (sort @{$self->{'runfiles'}}) { + print $fd " $_\n"; + } + } + foreach my $arch (sort keys %{$self->{'binfiles'}}) { + if (@{$self->{'binfiles'}{$arch}}) { + print $fd "binfiles arch=$arch\n"; + foreach (sort @{$self->{'binfiles'}{$arch}}) { + print $fd " $_\n"; + } + } + } } sub make_zip { - my ($self,$tltree,$destdir,$zipname) = @_; - my $zipn; - if (not(defined($zipname))) { - $zipname = $self->name . ".zip"; - } - if (not(defined($destdir))) { - $destdir = TeXLive::TLPOBJ->zipdir; - } - die("Undefined tltree argument!") if (not(defined($tltree))); - # first build the arch independet part - $self->_make_zip($tltree,$destdir,$zipname,"all"); - # now the $pkg.$arch.zip - if ($self->is_arch_dependent) { - foreach my $t (keys %{$self->{'binfiles'}}) { - &TeXLive::TLUtils::debug("arch=$t\n"); - if ($zipname =~ /^(.*)\.zip$/) { - $zipn = "$1.$t.zip"; - } else { - $zipn = "$zipname.$t.zip"; - } - $self->_make_zip($tltree,$destdir,$zipn,$t); - } - } + my ($self,$tltree,$destdir,$zipname) = @_; + my $zipn; + if (not(defined($zipname))) { + $zipname = $self->name . ".zip"; + } + if (not(defined($destdir))) { + $destdir = TeXLive::TLPOBJ->zipdir; + } + die("Undefined tltree argument!") if (not(defined($tltree))); + # first build the arch independet part + $self->_make_zip($tltree,$destdir,$zipname,"all"); + # now the $pkg.$arch.zip + if ($self->is_arch_dependent) { + foreach my $t (keys %{$self->{'binfiles'}}) { + &TeXLive::TLUtils::debug("arch=$t\n"); + if ($zipname =~ /^(.*)\.zip$/) { + $zipn = "$1.$t.zip"; + } else { + $zipn = "$zipname.$t.zip"; + } + $self->_make_zip($tltree,$destdir,$zipn,$t); + } + } } sub _make_zip { - my ($self,$tltree,$destdir,$zipname,$arch) = @_; - my $root = $tltree->svnroot; - my @files = (); - my $zipcmd; - if ($arch ne "all") { - push @files, @{$self->{'binfiles'}{$arch}}; - } else { - push @files, $self->runfiles; - push @files, $self->docfiles; - push @files, $self->srcfiles; - } - # 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 = TeXLive::TLUtils::sort_uniq(@files); - if (!@files) { - &TeXLive::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); + my ($self,$tltree,$destdir,$zipname,$arch) = @_; + my $root = $tltree->svnroot; + my @files = (); + my $zipcmd; + if ($arch ne "all") { + push @files, @{$self->{'binfiles'}{$arch}}; + } else { + push @files, $self->runfiles; + push @files, $self->docfiles; + push @files, $self->srcfiles; + } + # 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 = TeXLive::TLUtils::sort_uniq(@files); + if (!@files) { + &TeXLive::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; - } + my $self = shift; + if (keys %{$self->{'binfiles'}}) { + return 1; + } else { + return 0; + } } # computes the total size of a package # if no arguments are given this is -# docsize + runsize + srcsize + max of binsizes +# docsize + runsize + srcsize + max of binsizes sub total_size { - my ($self,@archs) = @_; - my $ret = $self->docsize + $self->runsize + $self->srcsize; - if ($self->is_arch_dependent) { - my $max = 0; - my %foo = %{$self->binsizes}; - foreach my $k (keys %foo) { - $max = $foo{$k} if ($foo{$k} > $max); - } - $ret += $max; - } - return($ret); + my ($self,@archs) = @_; + my $ret = $self->docsize + $self->runsize + $self->srcsize; + if ($self->is_arch_dependent) { + my $max = 0; + my %foo = %{$self->binsizes}; + foreach my $k (keys %foo) { + $max = $foo{$k} if ($foo{$k} > $max); + } + $ret += $max; + } + return($ret); } # # member access functions # sub name { - my $self = shift; - if (@_) { $self->{'name'} = shift } - return $self->{'name'}; + my $self = shift; + if (@_) { $self->{'name'} = shift } + return $self->{'name'}; } sub category { - my $self = shift; - if (@_) { $self->{'category'} = shift } - return $self->{'category'}; + my $self = shift; + if (@_) { $self->{'category'} = shift } + return $self->{'category'}; } sub shortdesc { - my $self = shift; - if (@_) { $self->{'shortdesc'} = shift } - return $self->{'shortdesc'}; + my $self = shift; + if (@_) { $self->{'shortdesc'} = shift } + return $self->{'shortdesc'}; } sub longdesc { - my $self = shift; - if (@_) { $self->{'longdesc'} = shift } - return $self->{'longdesc'}; + my $self = shift; + if (@_) { $self->{'longdesc'} = shift } + return $self->{'longdesc'}; } sub revision { - my $self = shift; - if (@_) { $self->{'revision'} = shift } - return $self->{'revision'}; + my $self = shift; + if (@_) { $self->{'revision'} = shift } + return $self->{'revision'}; } sub catalogue { - my $self = shift; - if (@_) { $self->{'catalogue'} = shift } - return $self->{'catalogue'}; + my $self = shift; + if (@_) { $self->{'catalogue'} = shift } + return $self->{'catalogue'}; } sub srcfiles { - my $self = shift; - if (@_) { @{ $self->{'srcfiles'} } = @_ } - return @{ $self->{'srcfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'srcfiles'} } = @_ } + return @{ $self->{'srcfiles'} }; } sub srcsize { - my $self = shift; - if (@_) { $self->{'srcsize'} = shift } - return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'srcsize'} = shift } + return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 ); } sub add_srcfiles { - my ($self,@files) = @_; - $self->add_files("src",@files); + my ($self,@files) = @_; + $self->add_files("src",@files); } sub remove_srcfiles { - my ($self,@files) = @_; - $self->remove_files("src",@files); + my ($self,@files) = @_; + $self->remove_files("src",@files); } sub docfiles { - my $self = shift; - if (@_) { @{ $self->{'docfiles'} } = @_ } - return @{ $self->{'docfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'docfiles'} } = @_ } + return @{ $self->{'docfiles'} }; } sub docsize { - my $self = shift; - if (@_) { $self->{'docsize'} = shift } - return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'docsize'} = shift } + return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 ); } sub add_docfiles { - my ($self,@files) = @_; - $self->add_files("doc",@files); + my ($self,@files) = @_; + $self->add_files("doc",@files); } sub remove_docfiles { - my ($self,@files) = @_; - $self->remove_files("doc",@files); + my ($self,@files) = @_; + $self->remove_files("doc",@files); } sub binfiles { - my $self = shift; - my %newfiles = @_; - if (@_) { $self->{'binfiles'} = \%newfiles } - return $self->{'binfiles'}; + my $self = shift; + my %newfiles = @_; + if (@_) { $self->{'binfiles'} = \%newfiles } + return $self->{'binfiles'}; } sub binsizes { - my $self = shift; - my %newsizes = @_; - if (@_) { $self->{'binsizes'} = \%newsizes } - return $self->{'binsizes'}; + my $self = shift; + my %newsizes = @_; + if (@_) { $self->{'binsizes'} = \%newsizes } + return $self->{'binsizes'}; } sub add_binfiles { - my ($self,$arch,@files) = @_; - &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files); + my ($self,$arch,@files) = @_; + &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files); } sub remove_binfiles { - my ($self,$arch,@files) = @_; - my @finalfiles; - foreach my $f (@{$self->{'binfiles'}{$arch}}) { - if (not(&TeXLive::TLUtils::member($f,@files))) { - push @finalfiles,$f; - } - } - $self->{'binfiles'}{$arch} = [ @finalfiles ]; + my ($self,$arch,@files) = @_; + my @finalfiles; + foreach my $f (@{$self->{'binfiles'}{$arch}}) { + if (not(&TeXLive::TLUtils::member($f,@files))) { + push @finalfiles,$f; + } + } + $self->{'binfiles'}{$arch} = [ @finalfiles ]; } sub runfiles { - my $self = shift; - if (@_) { @{ $self->{'runfiles'} } = @_ } - return @{ $self->{'runfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'runfiles'} } = @_ } + return @{ $self->{'runfiles'} }; } sub runsize { - my $self = shift; - if (@_) { $self->{'runsize'} = shift } - return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'runsize'} = shift } + return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 ); } sub add_runfiles { - my ($self,@files) = @_; - $self->add_files("run",@files); + my ($self,@files) = @_; + $self->add_files("run",@files); } sub remove_runfiles { - my ($self,@files) = @_; - $self->remove_files("run",@files); + my ($self,@files) = @_; + $self->remove_files("run",@files); } sub add_files { - my ($self,$type,@files) = @_; - die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); - &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files); + my ($self,$type,@files) = @_; + die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); + &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files); } sub remove_files { - my ($self,$type,@files) = @_; - die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); - my @finalfiles; - foreach my $f (@{$self->{"${type}files"}}) { - if (not(&TeXLive::TLUtils::member($f,@files))) { - push @finalfiles,$f; - } - } - $self->{"${type}files"} = [ @finalfiles ]; + my ($self,$type,@files) = @_; + die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); + my @finalfiles; + foreach my $f (@{$self->{"${type}files"}}) { + if (not(&TeXLive::TLUtils::member($f,@files))) { + push @finalfiles,$f; + } + } + $self->{"${type}files"} = [ @finalfiles ]; } sub depends { - my $self = shift; - if (@_) { @{ $self->{'depends'} } = @_ } - return @{ $self->{'depends'} }; + my $self = shift; + if (@_) { @{ $self->{'depends'} } = @_ } + return @{ $self->{'depends'} }; } sub executes { - my $self = shift; - if (@_) { @{ $self->{'executes'} } = @_ } - return @{ $self->{'executes'} }; + my $self = shift; + if (@_) { @{ $self->{'executes'} } = @_ } + return @{ $self->{'executes'} }; } sub zipdir { - my @self = shift; - if (@_) { $_zipdir = $_[0] } - return $_zipdir; + my @self = shift; + if (@_) { $_zipdir = $_[0] } + return $_zipdir; } 1; @@ -576,15 +576,13 @@ sub zipdir { ###### Formats format multilineformat = -^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -$_tmp - ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ +longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ $_tmp . ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index 9497a6f962e..c1efda1c33b 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -1,6 +1,6 @@ # # TeXLive::TLPSRC.pm -# module for using tlsrc files +# module for using tlpsrc files # Copyright 2007 Norbert Preining # # This file is licensed under the GNU General Public Licence version 2 @@ -15,177 +15,151 @@ use TeXLive::TLTREE; my $_tmp; sub new { - my $class = shift; - my %params = @_; - my $self = { - name => $params{'name'}, - category => defined($params{'category'}) ? $params{'category'} : "Package", - shortdesc => $params{'shortdesc'}, - longdesc => $params{'longdesc'}, - catalogue => $params{'catalogue'}, - runpatterns => $params{'runpatterns'}, - srcpatterns => $params{'srcpatterns'}, - docpatterns => $params{'docpatterns'}, - binpatterns => $params{'binpatterns'}, - executes => defined($params{'executes'}) ? $params{'executes'} : [], - depends => defined($params{'depends'}) ? $params{'depends'} : [], - }; - bless $self, $class; - return $self; + my $class = shift; + my %params = @_; + my $self = { + name => $params{'name'}, + category => defined($params{'category'}) ? $params{'category'} : "Package", + shortdesc => $params{'shortdesc'}, + longdesc => $params{'longdesc'}, + catalogue => $params{'catalogue'}, + runpatterns => $params{'runpatterns'}, + srcpatterns => $params{'srcpatterns'}, + docpatterns => $params{'docpatterns'}, + binpatterns => $params{'binpatterns'}, + executes => defined($params{'executes'}) ? $params{'executes'} : [], + depends => defined($params{'depends'}) ? $params{'depends'} : [], + }; + bless $self, $class; + return $self; } sub from_file { - my $self = shift; - if (@_ != 1) { - die("Need a filename for initialization!"); - } - open(TMP,"<$_[0]") || die("Cannot open tlsrc file: $_[0]"); - my @lines = <TMP>; - close(TMP); - my $name = ""; - # default category = Package - my $category = "Package"; - my $shortdesc = ""; - my $longdesc= ""; - my $catalogue = ""; - my (@executes, @depends); - my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns); - my $started = 0; - my $finished = 0; - my $lastcmd = ""; + my $self = shift; + if (@_ != 1) { + die("Need a filename for initialization!"); + } + open(TMP,"<$_[0]") || die("Cannot open tlpsrc file: $_[0]"); + my @lines = <TMP>; + close(TMP); + my $name = ""; + # default category = Package + my $category = "Package"; + my $shortdesc = ""; + my $longdesc= ""; + my $catalogue = ""; + my (@executes, @depends); + my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns); + my $started = 0; + my $finished = 0; - foreach my $line (@lines) { - $line =~ /^\s*#/ && next; # skip comment lines - if ($line =~ /^\s*$/) { - if (!$started) { next; } - if ($finished) { next; } - die("No empty line allowed in tlsrc file $_[0]!"); - } - if ($line =~ /^ /) { - if ( ($lastcmd eq "longdesc") || - ($lastcmd eq "runpatterns") || - ($lastcmd eq "binpatterns") || - ($lastcmd eq "docpatterns") || - ($lastcmd eq "srcpatterns") || - ($lastcmd eq "execute") || - ($lastcmd eq "depend") ) { - $line =~ s/^ /$lastcmd /; - } else { - die("Continuation of $lastcmd not allowed, please fix tlsrc!\n"); - } - } - if ($line =~ /^name\s*([-\w]+)$/) { - $name = "$1"; - $lastcmd = "name"; - $started && die("Cannot have two name directives!"); - $started = 1; - } else { - $started || die("First directive needs to be 'name'"); - if ($line =~ /^shortdesc\s*(.*)$/) { - $shortdesc = "$1"; - $lastcmd = "shortdesc"; - next; - } elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) { - $category = "$1"; - $lastcmd = "category"; - next; - } elsif ($line =~ /^longdesc\s+(.*)$/) { - $longdesc .= "$1 "; - $lastcmd = "longdesc"; - next; - } elsif ($line =~ /^catalogue\s+(.*)$/) { - $catalogue = "$1"; - $lastcmd = "catalogue"; - next; - } elsif ($line =~ /^runpatterns\s+(.*)$/) { - push @runpatterns, "$1" if ("$1" ne ""); - $lastcmd = "runpatterns"; - next; - } elsif ($line =~ /^srcpatterns\s+(.*)$/) { - push @srcpatterns, "$1" if ("$1" ne ""); - $lastcmd = "srcpatterns"; - next; - } elsif ($line =~ /^docpatterns\s+(.*)$/) { - push @docpatterns, "$1" if ("$1" ne ""); - $lastcmd = "docpatterns"; - next; - } elsif ($line =~ /^binpatterns\s+(.*)$/) { - push @binpatterns, "$1" if ("$1" ne ""); - $lastcmd = "binpatterns"; - next; - } elsif ($line =~ /^execute\s+(.*)$/) { - push @executes, "$1" if ("$1" ne ""); - $lastcmd = "execute"; - next; - } elsif ($line =~ /^depend\s+(.*)$/) { - push @depends, "$1" if ("$1" ne ""); - $lastcmd = "depend"; - next; - } else { - #die("Unknown directive ...$line... in $_[0], please fix it!"); - print STDERR "Unknown directive ...$line... in $_[0], please fix it!\n"; - } - } - } - $self->name("$name"); - $self->category("$category"); - $self->catalogue($catalogue ne "" ? "$catalogue" : "$name"); - $self->shortdesc("$shortdesc") if ($shortdesc ne ""); - $self->longdesc("$longdesc") if ($longdesc ne ""); - $self->srcpatterns(@srcpatterns) if ($#srcpatterns >= 0); - $self->runpatterns(@runpatterns) if ($#runpatterns >= 0); - $self->binpatterns(@binpatterns) if ($#binpatterns >= 0); - $self->docpatterns(@docpatterns) if ($#docpatterns >= 0); - $self->executes(@executes) if ($#executes >= 0); - $self->depends(@depends) if ($#depends >= 0); + foreach my $line (@lines) { + $line =~ /^\s*#/ && next; # skip comment lines + if ($line =~ /^\s*$/) { + if (!$started) { next; } + if ($finished) { next; } + die("No empty line allowed in tlpsrc file $_[0]!"); + } + if ($line =~ /^ /) { + die("No continuation lines >>>$line<<< allowed in TLPSRC files!"); + } + if ($line =~ /^name\s*([-\w]+)$/) { + $name = "$1"; + $started && die("Cannot have two name directives!"); + $started = 1; + } else { + $started || die("First directive needs to be 'name'"); + if ($line =~ /^shortdesc\s*(.*)$/) { + $shortdesc = "$1"; + next; + } elsif ($line =~ /^category\s+(Collection|Scheme|Package|TLCore|Documentation)$/) { + $category = "$1"; + next; + } elsif ($line =~ /^longdesc\s+(.*)$/) { + $longdesc .= "$1 "; + next; + } elsif ($line =~ /^catalogue\s+(.*)$/) { + $catalogue = "$1"; + next; + } elsif ($line =~ /^runpattern\s+(.*)$/) { + push @runpatterns, "$1" if ("$1" ne ""); + next; + } elsif ($line =~ /^srcpattern\s+(.*)$/) { + push @srcpatterns, "$1" if ("$1" ne ""); + next; + } elsif ($line =~ /^docpattern\s+(.*)$/) { + push @docpatterns, "$1" if ("$1" ne ""); + next; + } elsif ($line =~ /^binpattern\s+(.*)$/) { + push @binpatterns, "$1" if ("$1" ne ""); + next; + } elsif ($line =~ /^execute\s+(.*)$/) { + push @executes, "$1" if ("$1" ne ""); + next; + } elsif ($line =~ /^depend\s+(.*)$/) { + push @depends, "$1" if ("$1" ne ""); + next; + } else { + #die("Unknown directive ...$line... in $_[0], please fix it!"); + print STDERR "Unknown directive ...$line... in $_[0], please fix it!\n"; + } + } + } + $self->name("$name"); + $self->category("$category"); + $self->catalogue($catalogue) if ("$catalogue" ne ""); + $self->shortdesc("$shortdesc") if ($shortdesc ne ""); + $self->longdesc("$longdesc") if ($longdesc ne ""); + $self->srcpatterns(@srcpatterns) if ($#srcpatterns >= 0); + $self->runpatterns(@runpatterns) if ($#runpatterns >= 0); + $self->binpatterns(@binpatterns) if ($#binpatterns >= 0); + $self->docpatterns(@docpatterns) if ($#docpatterns >= 0); + $self->executes(@executes) if ($#executes >= 0); + $self->depends(@depends) if ($#depends >= 0); } sub writeout { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - format_name $fd "multilineformat"; - print $fd "name ", $self->name, "\n"; - print $fd "category ", $self->category, "\n"; - print $fd "catalogue $self->{'catalogue'}\n"; - defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; - if (defined($self->{'longdesc'})) { - $_tmp = "longdesc $self->{'longdesc'}"; - write $fd; - } - if (defined($self->{'depends'})) { - foreach (@{$self->{'depends'}}) { - print $fd "depend $_\n"; - } - } - if (defined($self->{'executes'})) { - foreach (@{$self->{'executes'}}) { - print $fd "execute $_\n"; - } - } - if (defined($self->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) { - print $fd "srcpatterns\n"; - foreach (sort @{$self->{'srcpatterns'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'runpatterns'}) && (@{$self->{'runpatterns'}})) { - print $fd "runpatterns\n"; - foreach (sort @{$self->{'runpatterns'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'docpatterns'}) && (@{$self->{'docpatterns'}})) { - print $fd "docpatterns\n"; - foreach (sort @{$self->{'docpatterns'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'binpatterns'}) && (@{$self->{'binpatterns'}})) { - print $fd "binpatterns\n"; - foreach (sort @{$self->{'binpatterns'}}) { - print $fd " $_\n"; - } - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + format_name $fd "multilineformat"; + print $fd "name ", $self->name, "\n"; + print $fd "category ", $self->category, "\n"; + defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; + defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; + if (defined($self->{'longdesc'})) { + $_tmp = "$self->{'longdesc'}"; + write $fd; + } + if (defined($self->{'depends'})) { + foreach (@{$self->{'depends'}}) { + print $fd "depend $_\n"; + } + } + if (defined($self->{'executes'})) { + foreach (@{$self->{'executes'}}) { + print $fd "execute $_\n"; + } + } + if (defined($self->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) { + foreach (sort @{$self->{'srcpatterns'}}) { + print $fd "srcpattern $_\n"; + } + } + if (defined($self->{'runpatterns'}) && (@{$self->{'runpatterns'}})) { + foreach (sort @{$self->{'runpatterns'}}) { + print $fd "runpattern $_\n"; + } + } + if (defined($self->{'docpatterns'}) && (@{$self->{'docpatterns'}})) { + foreach (sort @{$self->{'docpatterns'}}) { + print $fd "docpattern $_\n"; + } + } + if (defined($self->{'binpatterns'}) && (@{$self->{'binpatterns'}})) { + foreach (sort @{$self->{'binpatterns'}}) { + print $fd "binpattern $_\n"; + } + } } # @@ -193,227 +167,225 @@ sub writeout { # sub make_tlpobj { - my ($self,$tltree) = @_; - my $tlp = TeXLive::TLPOBJ->new; - $tlp->name($self->name); - $tlp->category($self->category); - $tlp->shortdesc($self->{'shortdesc'}) if (defined($self->{'shortdesc'})); - $tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'})); - $tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'})); - $tlp->executes(@{$self->{'executes'}}) if (defined($self->{'executes'})); - $tlp->depends(@{$self->{'depends'}}) if (defined($self->{'depends'})); - $tlp->revision(0); - my $filemax; - my $usedefault = 1; - my @allpospats; - my @allnegpats; - foreach my $p (@{$self->{'runpatterns'}}) { - if ($p =~ m/^\+!(.*)$/) { - push @allnegpats, $1; - } elsif ($p =~ m/^\+(.*)$/) { - push @allpospats, $1; - } elsif ($p =~ m/^!(.*)$/) { - push @allnegpats, $1; - $usedefault = 0; - } else { - push @allpospats, $p; - $usedefault = 0; - } - } - if ($usedefault) { - if ($self->category eq "Package") { - foreach my $md (qw/bibtex context dvips fonts makeindex metafont - metapost mft omega scripts tex vtex/) { - push @allpospats, "t texmf-dist $md $self->{'name'}"; - } - } - } - foreach my $p (@allpospats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'run'); - } - foreach my $p (@allnegpats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'run',1); - } - @allpospats = (); - @allnegpats = (); - $usedefault = 1; - foreach my $p (@{$self->{'srcpatterns'}}) { - if ($p =~ m/^\+!(.*)$/) { - push @allnegpats, $1; - } elsif ($p =~ m/^\+(.*)$/) { - push @allpospats, $1; - } elsif ($p =~ m/^!(.*)$/) { - push @allnegpats, $1; - $usedefault = 0; - } else { - push @allpospats, $p; - $usedefault = 0; - } - } - if ($usedefault) { - # default patterns for srcfiles - if ($self->category eq "Package") { - push @allpospats, "t texmf-dist source $self->{'name'}"; - } elsif ($self->category eq "Documentation") { - push @allpospats, "t texmf-doc source $self->{'name'}"; - } - } - foreach my $p (@allpospats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'src'); - } - foreach my $p (@allnegpats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'src',1); - } - @allpospats = (); - @allnegpats = (); - $usedefault = 1; - foreach my $p (@{$self->{'docpatterns'}}) { - if ($p =~ m/^\+!(.*)$/) { - push @allnegpats, $1; - } elsif ($p =~ m/^\+(.*)$/) { - push @allpospats, $1; - } elsif ($p =~ m/^!(.*)$/) { - push @allnegpats, $1; - $usedefault = 0; - } else { - push @allpospats, $p; - $usedefault = 0; - } - } - if ($usedefault) { - # default patterns for docfiles - if ($self->category eq "Package") { - push @allpospats, "t texmf-dist doc $self->{'name'}"; - } elsif ($self->category eq "Documentation") { - push @allpospats, "t texmf-doc doc $self->{'name'}"; - } - } - foreach my $p (@allpospats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'doc'); - } - foreach my $p (@allnegpats) { - $self->_do_normal_pattern($p,$tlp,$tltree,'doc',1); - } - # no default patterns for binfiles - @allpospats = (); - @allnegpats = (); - foreach my $p (@{$self->{'binpatterns'}}) { - if ($p =~ m/^\+!(.*)$/) { - push @allnegpats, $1; - } elsif ($p =~ m/^\+(.*)$/) { - push @allpospats, $1; - } elsif ($p =~ m/^!(.*)$/) { - push @allnegpats, $1; - } else { - push @allpospats, $p; - } - } - foreach my $p (@allpospats) { - my $matchref; - $matchref = $tltree->get_matching_files('bin',$p); - my %archmatches = %$matchref; - my @archs = $tltree->architectures; - foreach my $arch (@archs) { - $tlp->add_binfiles($arch,@{$archmatches{$arch}}); - } - } - foreach my $p (@allnegpats) { - my $matchref; - $matchref = $tltree->get_matching_files('bin',$p); - my %archmatches = %$matchref; - my @archs = $tltree->architectures; - foreach my $arch (@archs) { - $tlp->remove_binfiles($arch,@{$archmatches{$arch}}); - } - } - $tlp->recompute_sizes($tltree); - $tlp->recompute_revision($tltree); - return $tlp; + my ($self,$tltree) = @_; + my $tlp = TeXLive::TLPOBJ->new; + $tlp->name($self->name); + $tlp->category($self->category); + $tlp->shortdesc($self->{'shortdesc'}) if (defined($self->{'shortdesc'})); + $tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'})); + $tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'})); + $tlp->executes(@{$self->{'executes'}}) if (defined($self->{'executes'})); + $tlp->depends(@{$self->{'depends'}}) if (defined($self->{'depends'})); + $tlp->revision(0); + my $filemax; + my $usedefault = 1; + my @allpospats; + my @allnegpats; + foreach my $p (@{$self->{'runpatterns'}}) { + if ($p =~ m/^\+!(.*)$/) { + push @allnegpats, $1; + } elsif ($p =~ m/^\+(.*)$/) { + push @allpospats, $1; + } elsif ($p =~ m/^!(.*)$/) { + push @allnegpats, $1; + $usedefault = 0; + } else { + push @allpospats, $p; + $usedefault = 0; + } + } + if ($usedefault) { + if ($self->category eq "Package") { + foreach my $md (qw/bibtex context dvips fonts makeindex metafont + metapost mft omega scripts tex vtex/) { + push @allpospats, "t texmf-dist $md $self->{'name'}"; + } + } + } + foreach my $p (@allpospats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'run'); + } + foreach my $p (@allnegpats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'run',1); + } + @allpospats = (); + @allnegpats = (); + $usedefault = 1; + foreach my $p (@{$self->{'srcpatterns'}}) { + if ($p =~ m/^\+!(.*)$/) { + push @allnegpats, $1; + } elsif ($p =~ m/^\+(.*)$/) { + push @allpospats, $1; + } elsif ($p =~ m/^!(.*)$/) { + push @allnegpats, $1; + $usedefault = 0; + } else { + push @allpospats, $p; + $usedefault = 0; + } + } + if ($usedefault) { + # default patterns for srcfiles + if ($self->category eq "Package") { + push @allpospats, "t texmf-dist source $self->{'name'}"; + } elsif ($self->category eq "Documentation") { + push @allpospats, "t texmf-doc source $self->{'name'}"; + } + } + foreach my $p (@allpospats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'src'); + } + foreach my $p (@allnegpats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'src',1); + } + @allpospats = (); + @allnegpats = (); + $usedefault = 1; + foreach my $p (@{$self->{'docpatterns'}}) { + if ($p =~ m/^\+!(.*)$/) { + push @allnegpats, $1; + } elsif ($p =~ m/^\+(.*)$/) { + push @allpospats, $1; + } elsif ($p =~ m/^!(.*)$/) { + push @allnegpats, $1; + $usedefault = 0; + } else { + push @allpospats, $p; + $usedefault = 0; + } + } + if ($usedefault) { + # default patterns for docfiles + if ($self->category eq "Package") { + push @allpospats, "t texmf-dist doc $self->{'name'}"; + } elsif ($self->category eq "Documentation") { + push @allpospats, "t texmf-doc doc $self->{'name'}"; + } + } + foreach my $p (@allpospats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'doc'); + } + foreach my $p (@allnegpats) { + $self->_do_normal_pattern($p,$tlp,$tltree,'doc',1); + } + # no default patterns for binfiles + @allpospats = (); + @allnegpats = (); + foreach my $p (@{$self->{'binpatterns'}}) { + if ($p =~ m/^\+!(.*)$/) { + push @allnegpats, $1; + } elsif ($p =~ m/^\+(.*)$/) { + push @allpospats, $1; + } elsif ($p =~ m/^!(.*)$/) { + push @allnegpats, $1; + } else { + push @allpospats, $p; + } + } + foreach my $p (@allpospats) { + my $matchref; + $matchref = $tltree->get_matching_files('bin',$p); + my %archmatches = %$matchref; + my @archs = $tltree->architectures; + foreach my $arch (@archs) { + $tlp->add_binfiles($arch,@{$archmatches{$arch}}); + } + } + foreach my $p (@allnegpats) { + my $matchref; + $matchref = $tltree->get_matching_files('bin',$p); + my %archmatches = %$matchref; + my @archs = $tltree->architectures; + foreach my $arch (@archs) { + $tlp->remove_binfiles($arch,@{$archmatches{$arch}}); + } + } + $tlp->recompute_sizes($tltree); + $tlp->recompute_revision($tltree); + return $tlp; } sub _do_normal_pattern { - my ($self,$p,$tlp,$tltree,$type,$negative) = @_; - my $matchref = $tltree->get_matching_files($type,$p); - my @matchfiles = @$matchref; - if (defined($negative) && $negative == 1) { - $tlp->remove_files($type,@matchfiles); - } else { - $tlp->add_files($type,@matchfiles); - } + my ($self,$p,$tlp,$tltree,$type,$negative) = @_; + my $matchref = $tltree->get_matching_files($type,$p); + my @matchfiles = @$matchref; + if (defined($negative) && $negative == 1) { + $tlp->remove_files($type,@matchfiles); + } else { + $tlp->add_files($type,@matchfiles); + } } # # member access functions # sub name { - my $self = shift; - if (@_) { $self->{'name'} = shift } - return $self->{'name'}; + my $self = shift; + if (@_) { $self->{'name'} = shift } + return $self->{'name'}; } sub category { - my $self = shift; - if (@_) { $self->{'category'} = shift } - return $self->{'category'}; + my $self = shift; + if (@_) { $self->{'category'} = shift } + return $self->{'category'}; } sub shortdesc { - my $self = shift; - if (@_) { $self->{'shortdesc'} = shift } - return $self->{'shortdesc'}; + my $self = shift; + if (@_) { $self->{'shortdesc'} = shift } + return $self->{'shortdesc'}; } sub longdesc { - my $self = shift; - if (@_) { $self->{'longdesc'} = shift } - return $self->{'longdesc'}; + my $self = shift; + if (@_) { $self->{'longdesc'} = shift } + return $self->{'longdesc'}; } sub catalogue { - my $self = shift; - if (@_) { $self->{'catalogue'} = shift } - return $self->{'catalogue'}; + my $self = shift; + if (@_) { $self->{'catalogue'} = shift } + return $self->{'catalogue'}; } sub srcpatterns { - my $self = shift; - if (@_) { @{ $self->{'srcpatterns'} } = @_ } - return @{ $self->{'srcpatterns'} }; + my $self = shift; + if (@_) { @{ $self->{'srcpatterns'} } = @_ } + return @{ $self->{'srcpatterns'} }; } sub docpatterns { - my $self = shift; - if (@_) { @{ $self->{'docpatterns'} } = @_ } - return @{ $self->{'docpatterns'} }; + my $self = shift; + if (@_) { @{ $self->{'docpatterns'} } = @_ } + return @{ $self->{'docpatterns'} }; } sub binpatterns { - my $self = shift; - if (@_) { @{ $self->{'binpatterns'} } = @_ } - return @{ $self->{'binpatterns'} }; + my $self = shift; + if (@_) { @{ $self->{'binpatterns'} } = @_ } + return @{ $self->{'binpatterns'} }; } sub depends { - my $self = shift; - if (@_) { @{ $self->{'depends'} } = @_ } - return @{ $self->{'depends'} }; + my $self = shift; + if (@_) { @{ $self->{'depends'} } = @_ } + return @{ $self->{'depends'} }; } sub runpatterns { - my $self = shift; - if (@_) { @{ $self->{'runpatterns'} } = @_ } - return @{ $self->{'runpatterns'} }; + my $self = shift; + if (@_) { @{ $self->{'runpatterns'} } = @_ } + return @{ $self->{'runpatterns'} }; } sub executes { - my $self = shift; - if (@_) { @{ $self->{'executes'} } = @_ } - return @{ $self->{'executes'} }; + my $self = shift; + if (@_) { @{ $self->{'executes'} } = @_ } + return @{ $self->{'executes'} }; } 1; # FORMATS format multilineformat = -^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -$_tmp - ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ +longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ $_tmp . ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm index 27294e6bbc9..f979618b303 100644 --- a/Master/tlpkg/TeXLive/TLTREE.pm +++ b/Master/tlpkg/TeXLive/TLTREE.pm @@ -11,201 +11,202 @@ package TeXLive::TLTREE; use TeXLive::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/; + i386-linux i386-openbsd i386-solaris mips-irix powerpc-aix powerpc-darwin + powerpc-linux sparc-linux sparc-solaris win32 x86_64-linux/; sub new { - my $class = shift; - my %params = @_; - my $self = { - svnroot => $params{'svnroot'}, - # private stuff - _allfiles => {}, - _dirtree => {}, - _dirnames => {}, - _filesofdir => {}, - _subdirsofdir => {}, - }; - bless $self, $class; - return $self; + my $class = shift; + my %params = @_; + my $self = { + svnroot => $params{'svnroot'}, + # private stuff + _allfiles => {}, + _dirtree => {}, + _dirnames => {}, + _filesofdir => {}, + _subdirsofdir => {}, + }; + bless $self, $class; + return $self; } sub init_from_svn { - my $self = shift; - die("Undefined svn root!") if (!defined($self->{'svnroot'})); - my @lines = `cd $self->{'svnroot'} && svn status -v`; - $self->_initialize_lines(@lines); + my $self = shift; + die("Undefined svn root!") if (!defined($self->{'svnroot'})); + my @lines = `cd $self->{'svnroot'} && svn status -v`; + $self->_initialize_lines(@lines); } sub init_from_statusfile { - my $self = shift; - die("Need a filename of svn status file!") if (@_ != 1); - open(TMP,"<$_[0]") || die("Cannot open svn status file: $_[0]"); - my @lines = <TMP>; - close(TMP); - $self->_initialize_lines(@lines); + my $self = shift; + die("Need a filename of svn status file!") if (@_ != 1); + open(TMP,"<$_[0]") || die("Cannot open svn status file: $_[0]"); + my @lines = <TMP>; + close(TMP); + $self->_initialize_lines(@lines); } sub _initialize_lines { - my $self = shift; - my @lines = @_; - # we first chdir to the svn root, we need it for file tests - my $oldpwd = `pwd`; - chomp($oldpwd); - chdir($self->svnroot) || die("Cannot chdir to SVN root $self->{'svnroot'}!"); - foreach my $l (@lines) { - chomp($l); - next if ($l =~ /^\?/); # ignore files not under version control - if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+([\d\?]+)\s+([\w\?]+)\s+(.+)$/) { - my $lastchanged = $8; - my $entry = "$10"; - next if -d $entry; # TODO: what to do with links??? - $self->{'_allfiles'}{$entry}{'lastchangedrev'} = $lastchanged; - $self->{'_allfiles'}{$entry}{'size'} = (lstat $entry)[7]; - my $fn = TeXLive::TLUtils::basename($entry); - my $dn = TeXLive::TLUtils::dirname($entry); - add_path_to_tree($self->{'_dirtree'}, split("[/\\\\]", $dn)); - push @{$self->{'_filesofdir'}{$dn}}, $fn; - } else { - die("Cannot read svn status output line:\n $l\n"); - } - } - # now do some magic - # - create list of top level dirs with a list of full path names of - # the respective dir attached - $self->walk_tree(\&find_alldirs); - chdir($oldpwd); + my $self = shift; + my @lines = @_; + # we first chdir to the svn root, we need it for file tests + my $oldpwd = `pwd`; + chomp($oldpwd); + chdir($self->svnroot) || die("Cannot chdir to SVN root $self->{'svnroot'}!"); + foreach my $l (@lines) { + chomp($l); + next if ($l =~ /^\?/); # ignore files not under version control + if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+([\d\?]+)\s+([\w\?]+)\s+(.+)$/) { + my $lastchanged = $8; + my $entry = "$10"; + next if -d $entry; # TODO: what to do with links??? + $self->{'_allfiles'}{$entry}{'lastchangedrev'} = $lastchanged; + $self->{'_allfiles'}{$entry}{'size'} = (lstat $entry)[7]; + my $fn = TeXLive::TLUtils::basename($entry); + my $dn = TeXLive::TLUtils::dirname($entry); + add_path_to_tree($self->{'_dirtree'}, split("[/\\\\]", $dn)); + push @{$self->{'_filesofdir'}{$dn}}, $fn; + } else { + warn("Ignoring svn status output line:\n $l\n"); + #die("Cannot read svn status output line:\n $l\n"); + } + } + # now do some magic + # - create list of top level dirs with a list of full path names of + # the respective dir attached + $self->walk_tree(\&find_alldirs); + chdir($oldpwd); } sub print { - my $self = shift; - $self->walk_tree(\&print_node); + my $self = shift; + $self->walk_tree(\&print_node); } sub find_alldirs { - my ($self,$node, @stackdir) = @_; - my $tl = $stackdir[-1]; - push @{$self->{'_dirnames'}{$tl}}, join("/", @stackdir); - if (keys(%{$node})) { - my $pa = join("/", @stackdir); - push @{$self->{'_subdirsofdir'}{$pa}}, keys(%{$node}); - } + my ($self,$node, @stackdir) = @_; + my $tl = $stackdir[-1]; + push @{$self->{'_dirnames'}{$tl}}, join("/", @stackdir); + if (keys(%{$node})) { + my $pa = join("/", @stackdir); + push @{$self->{'_subdirsofdir'}{$pa}}, keys(%{$node}); + } } sub print_node { - my ($self,$node, @stackdir) = @_; - my $dp = join("/", @stackdir); - if ($self->{'_filesofdir'}{$dp}) { - foreach my $f (@{$self->{'_filesofdir'}{$dp}}) { - print "dp=$dp file=$f\n"; - } - } - if (! keys(%{$node})) { - print join("/", @stackdir) . "\n"; - } + my ($self,$node, @stackdir) = @_; + my $dp = join("/", @stackdir); + if ($self->{'_filesofdir'}{$dp}) { + foreach my $f (@{$self->{'_filesofdir'}{$dp}}) { + print "dp=$dp file=$f\n"; + } + } + if (! keys(%{$node})) { + print join("/", @stackdir) . "\n"; + } } sub walk_tree { - my $self = shift; - my (@stack_dir); - $self->_walk_tree1($self->{'_dirtree'},@_, @stack_dir); + my $self = shift; + my (@stack_dir); + $self->_walk_tree1($self->{'_dirtree'},@_, @stack_dir); } sub _walk_tree1 { - my $self = shift; - my ($node,$pre_proc, $post_proc, @stack_dir) = @_; - my $v; - for my $k (keys(%{$node})) { - push @stack_dir, $k; - $v = $node->{$k}; - if ($pre_proc) { &{$pre_proc}($self, $v, @stack_dir) } - $self->_walk_tree1 (\%{$v}, $pre_proc, $post_proc, @stack_dir); - $v = $node->{$k}; - if ($post_proc) { &{$post_proc}($self, $v, @stack_dir) } - pop @stack_dir; - } + my $self = shift; + my ($node,$pre_proc, $post_proc, @stack_dir) = @_; + my $v; + for my $k (keys(%{$node})) { + push @stack_dir, $k; + $v = $node->{$k}; + if ($pre_proc) { &{$pre_proc}($self, $v, @stack_dir) } + $self->_walk_tree1 (\%{$v}, $pre_proc, $post_proc, @stack_dir); + $v = $node->{$k}; + if ($post_proc) { &{$post_proc}($self, $v, @stack_dir) } + pop @stack_dir; + } } sub add_path_to_tree { - my ($node, @path) = @_; - my ($current); + my ($node, @path) = @_; + my ($current); - while (@path) { - $current = shift @path; - if ($$node{$current}) { - $node = $$node{$current}; - } else { - $$node{$current} = { }; - $node = $$node{$current}; - } - } - return $node; + while (@path) { + $current = shift @path; + if ($$node{$current}) { + $node = $$node{$current}; + } else { + $$node{$current} = { }; + $node = $$node{$current}; + } + } + return $node; } sub file_svn_lastrevision { - my $self = shift; - my $fn = shift; - if (defined($self->{'_allfiles'}{$fn})) { - return($self->{'_allfiles'}{$fn}{'lastchangedrev'}); - } else { - return(undef); - } + my $self = shift; + my $fn = shift; + if (defined($self->{'_allfiles'}{$fn})) { + return($self->{'_allfiles'}{$fn}{'lastchangedrev'}); + } else { + return(undef); + } } sub size_of { - my ($self,$f) = @_; - if (defined($self->{'_allfiles'}{$f})) { - return($self->{'_allfiles'}{$f}{'size'}); - } else { - return(undef); - } + my ($self,$f) = @_; + if (defined($self->{'_allfiles'}{$f})) { + return($self->{'_allfiles'}{$f}{'size'}); + } else { + return(undef); + } } sub get_matching_files { - my ($self, $type, $p) = @_; - if ($type eq "bin") { - # we first substitute arch for ${ARCH} - my %returnfiles; - foreach $a (@Architectures) { - # return empty list of arch!=win32 and pattern matches bin/win32 - # this is a special case to treat with tlsrc files auto generated - # from tpm files - if (($p =~ m@f bin/win32/@) && ($a ne "win32")) { - $returnfiles{$a} = [ ]; - next; - } - my $ARCH = $a; - my $newp; - eval "\$newp = \"$p\""; - my @foo = $self->_get_matching_files($type,$newp); - $returnfiles{$a} = [ @foo ]; - } - return(\%returnfiles); - } else { - my @returnfiles = $self->_get_matching_files($type,$p); - return(\@returnfiles); - } + my ($self, $type, $p) = @_; + if ($type eq "bin") { + # we first substitute arch for ${ARCH} + my %returnfiles; + foreach $a (@Architectures) { + # return empty list of arch!=win32 and pattern matches bin/win32 + # this is a special case to treat with tlsrc files auto generated + # from tpm files + if (($p =~ m@f bin/win32/@) && ($a ne "win32")) { + $returnfiles{$a} = [ ]; + next; + } + my $ARCH = $a; + my $newp; + eval "\$newp = \"$p\""; + my @foo = $self->_get_matching_files($type,$newp); + $returnfiles{$a} = [ @foo ]; + } + return(\%returnfiles); + } else { + my @returnfiles = $self->_get_matching_files($type,$p); + return(\@returnfiles); + } } - + sub _get_matching_files { - my ($self, $type, $p) = @_; - my ($pattype,$patdata,@rest) = split ' ',$p; - my @matchfiles; - &TeXLive::TLUtils::debug("check on $pattype,$patdata,@rest\n"); - if ($pattype eq "t") { - @matchfiles = $self->_get_files_matching_dir_pattern($type,$patdata,@rest); - } elsif ($pattype eq "f") { - @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") { - @matchfiles = $self->files_under_path($patdata); - } else { - die "Unknown pattern $p"; - } - TeXLive::TLUtils::debug("DEBUG: p=$p, matchfiles=@matchfiles\n"); - return @matchfiles; + my ($self, $type, $p) = @_; + my ($pattype,$patdata,@rest) = split ' ',$p; + my @matchfiles; + &TeXLive::TLUtils::debug("check on $pattype,$patdata,@rest\n"); + if ($pattype eq "t") { + @matchfiles = $self->_get_files_matching_dir_pattern($type,$patdata,@rest); + } elsif ($pattype eq "f") { + @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") { + @matchfiles = $self->files_under_path($patdata); + } else { + die "Unknown pattern $p"; + } + TeXLive::TLUtils::debug("DEBUG: p=$p, matchfiles=@matchfiles\n"); + return @matchfiles; } # @@ -213,73 +214,73 @@ sub _get_matching_files { # currently supported globs: ? * # # sequences of subsitutions: -# . -> \. +# . -> \. # * -> .* # ? -> . sub _get_files_matching_glob_pattern { - my $self = shift; - my ($type,$globline) = @_; - my @returnfiles; - my $dirpart = TeXLive::TLUtils::dirname($globline); - my $basepart = TeXLive::TLUtils::basename($globline); - $basepart =~ s/\./\\./g; - $basepart =~ s/\*/.*/g; - $basepart =~ s/\?/./g; - $basepart =~ s/\+/\\+/g; - return unless (defined($self->{'_filesofdir'}{$dirpart})); - my @candfiles = @{$self->{'_filesofdir'}{$dirpart}}; - foreach my $f (@candfiles) { - &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline\n"); - if ($f =~ /^$basepart$/) { - &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f\n"); - push @returnfiles, "$dirpart/$f"; - } - } - return(@returnfiles); + my $self = shift; + my ($type,$globline) = @_; + my @returnfiles; + my $dirpart = TeXLive::TLUtils::dirname($globline); + my $basepart = TeXLive::TLUtils::basename($globline); + $basepart =~ s/\./\\./g; + $basepart =~ s/\*/.*/g; + $basepart =~ s/\?/./g; + $basepart =~ s/\+/\\+/g; + return unless (defined($self->{'_filesofdir'}{$dirpart})); + my @candfiles = @{$self->{'_filesofdir'}{$dirpart}}; + foreach my $f (@candfiles) { + &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline\n"); + if ($f =~ /^$basepart$/) { + &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f\n"); + push @returnfiles, "$dirpart/$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$/) { - TeXLive::TLUtils::push_uniq(\@returnfiles,$f); - next FILELABEL; - } - } - return(@returnfiles); + my $self = shift; + my ($type,$regexp) = @_; + my @returnfiles; + FILELABEL: foreach my $f (keys(%{$self->{'_allfiles'}})) { + if ($f =~ /^$regexp$/) { + TeXLive::TLUtils::push_uniq(\@returnfiles,$f); + next FILELABEL; + } + } + return(@returnfiles); } sub _get_files_matching_dir_pattern { - my ($self,$type,@patwords) = @_; - my $tl = pop @patwords; - my @returnfiles; - if (defined($self->{'_dirnames'}{$tl})) { - foreach my $tld (@{$self->{'_dirnames'}{$tl}}) { - if (index($tld,join("/",@patwords)."/") == 0) { - my @files = $self->files_under_path($tld); - TeXLive::TLUtils::push_uniq(\@returnfiles, @files); - } - } - } - return(@returnfiles); + my ($self,$type,@patwords) = @_; + my $tl = pop @patwords; + my @returnfiles; + if (defined($self->{'_dirnames'}{$tl})) { + foreach my $tld (@{$self->{'_dirnames'}{$tl}}) { + if (index($tld,join("/",@patwords)."/") == 0) { + my @files = $self->files_under_path($tld); + TeXLive::TLUtils::push_uniq(\@returnfiles, @files); + } + } + } + return(@returnfiles); } sub files_under_path { - my $self = shift; - my $p = shift; - my @files = (); - foreach my $aa (@{$self->{'_filesofdir'}{$p}}) { - TeXLive::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); - TeXLive::TLUtils::push_uniq (\@files, @sdf); - } - } - return @files; + my $self = shift; + my $p = shift; + my @files = (); + foreach my $aa (@{$self->{'_filesofdir'}{$p}}) { + TeXLive::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); + TeXLive::TLUtils::push_uniq (\@files, @sdf); + } + } + return @files; } @@ -287,14 +288,14 @@ sub files_under_path { # member access functions # sub svnroot { - my $self = shift; - if (@_) { $self->{'svnroot'} = shift }; - return $self->{'svnroot'}; + my $self = shift; + if (@_) { $self->{'svnroot'} = shift }; + return $self->{'svnroot'}; } sub architectures { - my $self = shift; - if (@_) { @Architectures = @_ } - return @Architectures; + my $self = shift; + if (@_) { @Architectures = @_ } + return @Architectures; } @@ -302,8 +303,8 @@ sub architectures { 1; ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 533b9806fad..4d37c64bd0a 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -1,27 +1,27 @@ # TeXLive::TLUtils.pm # common functions for TeX Live Infrastructure -# +# # Copyright 2007 Norbert Preining # This file is licensed under the GNU General Public Licence version 2 # or any later version # -# based on Fabrice Popineau's FileUtils.pm. +# based on Fabrice Popineau's FileUtils.pm package TeXLive::TLUtils; =pod =head1 NAME -TeXLive::TLUtils - utilities used in the TeX Live infrastructure modules +TeXLive::TLUtils - utilities used in the TeX Live Infrastructure Modules =head1 SYNOPSIS - use TeXLive::TLUtils; + use TeXLive::TLUtils; - TeXLive::TLUtils::sort_uniq(@list); - TeXLive::TLUtils::push_uniq(\@list, @items); - TeXLive::TLUtils::member($item, @list); - TeXLive::TLUtils::debug($string); + TeXLive::TLUtils::sort_uniq(@list); + TeXLive::TLUtils::push_uniq(\@list, @items); + TeXLive::TLUtils::member($item, @list); + TeXLive::TLUtils::debug($string); =head1 DESCRIPTION @@ -30,15 +30,15 @@ TeXLive::TLUtils - utilities used in the TeX Live infrastructure modules 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 - ); + use Exporter (); + use Cwd; + use File::Path; + use vars qw( @ISA @EXPORT_OK ); + @ISA = qw(Exporter); + @EXPORT_OK = qw( + &sort_uniq + &push_uniq + ); } =pod @@ -49,17 +49,17 @@ occurrences of elements. It returns a sorted and unified array. =cut 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; + my (@l) = @_; + my ($e, $f, @r); + $f = ""; + @l = sort(@l); + foreach $e (@l) { + if ($e ne $f) { + $f = $e; + push @r, $e; + } + } + return @r; } =pod @@ -70,13 +70,13 @@ by the first argument. =cut sub push_uniq { - # can't we use $l as a reference, and then use my? later ... - local (*l, @le) = @_; - for my $e (@le) { - if (! &member($e, @l)) { - push @l, $e; - } - } + # can't we use $l as a reference, and then use my? later ... + local (*l, @le) = @_; + foreach my $e (@le) { + if (! &member($e, @l)) { + push @l, $e; + } + } } =pod @@ -87,14 +87,14 @@ in the list of the remaining arguments. =cut sub member { - my ($e, @l) = @_; - my ($f); - foreach $f (@l) { - if ($e eq $f) { - return 1; - } - } - return 0; + my ($e, @l) = @_; + my ($f); + foreach $f (@l) { + if ($e eq $f) { + return 1; + } + } + return 0; } =pod @@ -105,7 +105,7 @@ the global varialbe C<opt_debug> is set. =cut sub debug { - print STDERR @_ if ($::opt_debug); + print STDERR @_ if ($::opt_debug); } 1; @@ -128,8 +128,8 @@ repository trunk/Master/tlpkg/doc/. =cut ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # |