summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-06-18 14:23:18 +0000
committerNorbert Preining <preining@logic.at>2007-06-18 14:23:18 +0000
commitdfd6e494fcfcfe684312b959c68d589b06d33594 (patch)
tree9d14cbe7b574ddcb88afbc910ab89a4af4c7f7cf /Master/tlpkg/TeXLive
parent7fb60a74aab3febff8b73f2c8485f038d6a5e8cf (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.pm387
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm924
-rw-r--r--Master/tlpkg/TeXLive/TLPSRC.pm670
-rw-r--r--Master/tlpkg/TeXLive/TLTREE.pm437
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm96
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: #