summaryrefslogtreecommitdiff
path: root/new-infra/TLTREE.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-06-02 17:49:14 +0000
committerNorbert Preining <preining@logic.at>2007-06-02 17:49:14 +0000
commit4dc41c7ce0ba9d2d0f679d1d6825b5b29a4ccb35 (patch)
treeef81201ea064cc9d5c37e590b8ad9fa2e4e2910c /new-infra/TLTREE.pm
parent071ffccada1a34c3aa94fe1e5bfb0354a742d699 (diff)
loads of new-infra chnages, many things implemented (zip, multiarch, ...)
git-svn-id: svn://tug.org/texlive/trunk@4405 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'new-infra/TLTREE.pm')
-rw-r--r--new-infra/TLTREE.pm92
1 files changed, 41 insertions, 51 deletions
diff --git a/new-infra/TLTREE.pm b/new-infra/TLTREE.pm
index 60377e12d83..c45192b526d 100644
--- a/new-infra/TLTREE.pm
+++ b/new-infra/TLTREE.pm
@@ -8,6 +8,8 @@
package TLTREE;
+use TLUtils;
+
my @Architectures = qw/alpha-linux hppa-hpux i386-darwin i386-freebsd
i386-linux i386-openbsd i386-solaris mips-irix powerpc-aix powerpc-darwin
powerpc-linux sparc-linux sparc-solaris win32 x86_64-linux/;
@@ -54,20 +56,18 @@ sub _initialize_lines {
foreach my $l (@lines) {
chomp($l);
next if ($l =~ /^\?/); # ignore files not under version control
- if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+(\d+)\s+\w+\s+(.+)$/) {
+ if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+([\d\?]+)\s+([\w\?]+)\s+(.+)$/) {
my $lastchanged = $8;
- my $entry = "$9";
+ my $entry = "$10";
next if -d $entry; # TODO: what to do with links???
$self->{'_allfiles'}{$entry}{'lastchangedrev'} = $lastchanged;
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,
- $mtime,$ctime,$bklsize,$blocks) = stat($entry);
- $self->{'_allfiles'}{$entry}{'size'} = $size;
- my $fn = basename($entry);
- my $dn = dirname($entry);
+ $self->{'_allfiles'}{$entry}{'size'} = (lstat $entry)[7];
+ my $fn = TLUtils::basename($entry);
+ my $dn = TLUtils::dirname($entry);
add_path_to_tree($self->{'_dirtree'}, split("[/\\\\]", $dn));
push @{$self->{'_filesofdir'}{$dn}}, $fn;
} else {
- die("Cannot read svn status output line: $l");
+ die("Cannot read svn status output line:\n $l\n");
}
}
# now do some magic
@@ -142,42 +142,6 @@ sub add_path_to_tree {
return $node;
}
-sub member {
- my ($e, @l) = @_;
- my ($f);
- foreach $f (@l) {
- if ($e eq $f) {
- return 1;
- }
- }
- return 0;
-}
-
-sub push_uniq {
- my ($l,@le) = @_;
- my ($e);
- foreach $e (@le) {
- if (! &member($e, @$l)) {
- push @$l, $e;
- }
- }
-}
-
-sub dirname {
- my ($f) = @_;
- if ($f =~ m@(^.*)[\\/][^\\/]*$@) {
- return $1;
- } else {
- return ".";
- }
-}
-
-sub basename {
- my ($f) = @_;
- $f =~ m@([^\\/]*)$@;
- return $1;
-}
-
sub file_svn_lastrevision {
my $self = shift;
my $fn = shift;
@@ -224,9 +188,7 @@ sub _get_matching_files {
if ($pattype eq "t") {
@matchfiles = $self->_get_files_matching_dir_pattern($type,$patdata,@rest);
} elsif ($pattype eq "f") {
- if (defined($self->{'_allfiles'}{$patdata})) {
- @matchfiles = ( $patdata );
- }
+ @matchfiles = $self->_get_files_matching_glob_pattern($type,$patdata);
} elsif ($pattype eq "r") {
@matchfiles = $self->_get_files_matching_regexp_pattern($type,$patdata);
} elsif ($pattype eq "d") {
@@ -237,13 +199,41 @@ sub _get_matching_files {
return @matchfiles;
}
+#
+# we transform a glob pattern to a regexp pattern:
+# currently supported globs: ? *
+#
+# sequences of subsitutions:
+# . -> \.
+# * -> .*
+# ? -> .
+sub _get_files_matching_glob_pattern {
+ my $self = shift;
+ my ($type,$globline) = @_;
+ my @returnfiles;
+ my $dirpart = TLUtils::dirname($globline);
+ my $basepart = TLUtils::basename($globline);
+ $basepart =~ s/\./\\./;
+ $basepart =~ s/\*/.*/;
+ $basepart =~ s/\?/./;
+ return unless (defined($self->{'_filesofdir'}{$dirpart}));
+ my @candfiles = @{$self->{'_filesofdir'}{$dirpart}};
+ foreach my $f (@candfiles) {
+ &TLUtils::debug("matching $f in $dirpart via glob $globline\n");
+ if ($f =~ /^$basepart$/) {
+ push @returnfiles, $f;
+ }
+ }
+ return(@returnfiles);
+}
+
sub _get_files_matching_regexp_pattern {
my $self = shift;
my ($type,$regexp) = @_;
my @returnfiles;
FILELABEL: foreach my $f (keys(%{$self->{'_allfiles'}})) {
if ($f =~ /^$regexp$/) {
- push_uniq(\@returnfiles,$f);
+ TLUtils::push_uniq(\@returnfiles,$f);
next FILELABEL;
}
}
@@ -258,7 +248,7 @@ sub _get_files_matching_dir_pattern {
foreach my $tld (@{$self->{'_dirnames'}{$tl}}) {
if (index($tld,join("/",@patwords)."/") == 0) {
my @files = $self->files_under_path($tld);
- push_uniq(\@returnfiles, @files);
+ TLUtils::push_uniq(\@returnfiles, @files);
}
}
}
@@ -270,12 +260,12 @@ sub files_under_path {
my $p = shift;
my @files = ();
foreach my $aa (@{$self->{'_filesofdir'}{$p}}) {
- push_uniq( \@files, $p . "/" . $aa);
+ TLUtils::push_uniq(\@files, $p . "/" . $aa);
}
if (defined($self->{'_subdirsofdir'}{$p})) {
foreach my $sd (@{$self->{'_subdirsofdir'}{$p}}) {
my @sdf = $self->files_under_path($p . "/" . $sd);
- push_uniq (\@files, @sdf);
+ TLUtils::push_uniq (\@files, @sdf);
}
}
return @files;