diff options
author | Norbert Preining <preining@logic.at> | 2007-06-02 17:49:14 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-06-02 17:49:14 +0000 |
commit | 4dc41c7ce0ba9d2d0f679d1d6825b5b29a4ccb35 (patch) | |
tree | ef81201ea064cc9d5c37e590b8ad9fa2e4e2910c /new-infra/TLTREE.pm | |
parent | 071ffccada1a34c3aa94fe1e5bfb0354a742d699 (diff) |
loads of new-infra chnages, many things implemented (zip, multiarch, ...)
git-svn-id: svn://tug.org/texlive/trunk@4405 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'new-infra/TLTREE.pm')
-rw-r--r-- | new-infra/TLTREE.pm | 92 |
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; |