summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLTREE.pm
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/TLTREE.pm
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/TLTREE.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLTREE.pm437
1 files changed, 219 insertions, 218 deletions
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: #