diff options
author | Norbert Preining <preining@logic.at> | 2008-07-26 18:56:22 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-07-26 18:56:22 +0000 |
commit | 47f84d7024ed77e5f6ebb75e209b7e0ed4c8be3e (patch) | |
tree | d6f99138c037ea61575a9324aa90d58f9c35c929 /Master/tlpkg/TeXLive/TLTREE.pm | |
parent | 665acdd21c5a8bc2773bab7b41e010001d588199 (diff) |
pattern matching magic: now more archs can be given after a binpattern type, and also negated ones
git-svn-id: svn://tug.org/texlive/trunk@9793 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLTREE.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLTREE.pm | 44 |
1 files changed, 14 insertions, 30 deletions
diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm index f32d6ebf478..9fc0dd829d2 100644 --- a/Master/tlpkg/TeXLive/TLTREE.pm +++ b/Master/tlpkg/TeXLive/TLTREE.pm @@ -179,40 +179,24 @@ sub size_of { # return a per-architecture hash ref for TYPE eq "bin", # list ref for all others. # -sub get_matching_files { - my ($self, $type, $p) = @_; +=pod - if ($type eq "bin") { - my %returnfiles; - # binpatterns can have an additions specifier after the prefix: /ARCH - # which specifies that these patterns are ONLY for the specified arch! - if ($p =~ m!^(\w+)/([-a-z0-9]+)\s+(.*)$!) { - my $pt = $1; - my $aa = $2; - my $pr = $3; - my @foo = $self->_get_matching_files($type,"$pt $pr"); - $returnfiles{$aa} = [ @foo ]; - return \%returnfiles; - } +The function B<get_matching_files> takes as arguments the type of the pattern +(bin, src, doc, run), the pattern itself, and an options architecture. +It returns a list of files matching that pattern (in the case +of bin patterns for that arch). - # we first substitute arch for ${ARCH} - foreach $a ($self->architectures) { - # return empty list of arch!=win32 and pattern matches bin/win32 - 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; +=cut +sub get_matching_files { + my ($self, $type, $p, $arch) = @_; + if ($type eq "bin") { + my $ARCH = $arch; + my $newp; + eval "\$newp = \"$p\""; + return($self->_get_matching_files($type,$newp)); } else { # non-bin pattern - my @returnfiles = $self->_get_matching_files($type,$p); - return \@returnfiles; + return($self->_get_matching_files($type,$p)); } } |