From 47f84d7024ed77e5f6ebb75e209b7e0ed4c8be3e Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sat, 26 Jul 2008 18:56:22 +0000 Subject: 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 --- Master/tlpkg/TeXLive/TLMedia.pm | 15 ++-- Master/tlpkg/TeXLive/TLPSRC.pm | 147 +++++++++++++++++++++++++--------------- Master/tlpkg/TeXLive/TLTREE.pm | 44 ++++-------- 3 files changed, 116 insertions(+), 90 deletions(-) (limited to 'Master/tlpkg/TeXLive') diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm index 2f2737689f9..449534e23c6 100644 --- a/Master/tlpkg/TeXLive/TLMedia.pm +++ b/Master/tlpkg/TeXLive/TLMedia.pm @@ -92,7 +92,7 @@ sub install_package { my $tlpobj = $fromtlpdb->get_package($pkg); if (!defined($tlpobj)) { if (defined($fallbackmedia)) { - if ($ret = $fallbackmedia->install_package($pkg,$totlpdb)) { + if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nodepends, $nopostinstall)) { debug("installed $pkg from fallback"); return $ret; } else { @@ -206,25 +206,30 @@ sub install_package { # of the $nodepends setting foreach my $d ($tlpobj->depends) { if ($d =~ m/^(.*)\.ARCH$/) { + # we only want to try to install a .ARCH package if it actually contains + # files my $foo = $1; + my $hashref = $totlpdb->get_package("$foo"); + my %binfiles = %{$hashref}; foreach my $a ($totlpdb->available_architectures) { - if (!defined($totlpdb->get_package("$foo.$a"))) { + if (defined($binfiles{$a}) && + !defined($totlpdb->get_package("$foo.$a"))) { merge_into(\%ret, - $self->install_package("$foo.$a", $totlpdb, $nodepends, $fallbackmedia)); + $self->install_package("$foo.$a", $totlpdb, $nodepends, $fallbackmedia, 0)); } } } elsif ($d =~ m/^(.*).win32$/) { # install only of win32 is under the available archs if (TeXLive::TLUtils::member("win32",$totlpdb->available_architectures)) { merge_into(\%ret, - $self->install_package($d, $totlpdb, $nodepends, $fallbackmedia)); + $self->install_package($d, $totlpdb, $nodepends, $nopostinstall, $fallbackmedia)); } } else { if (!$nodepends) { if (!defined($totlpdb->get_package($d))) { # we have to install it! merge_into(\%ret, - $self->install_package($d, $totlpdb, $nodepends, $fallbackmedia)); + $self->install_package($d, $totlpdb, $nodepends, $nopostinstall, $fallbackmedia)); } } } diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index 7a36a3b1f59..3769aea9643 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -318,58 +318,81 @@ sub make_tlpobj } } foreach my $p (@allpospats) { - my $matchref; - $matchref = $tltree->get_matching_files('bin',$p); - my %archmatches = %$matchref; - my @archs = $tltree->architectures; - foreach my $arch (@archs) { - my @archfiles = (); - if (defined($archmatches{$arch})) { - @archfiles = @{$archmatches{$arch}}; - } - if (!@archfiles) { - # many patterns are special for w32, don't complain about those. - # conversely, w32 fails to have many standard programs, don't - # complain about those either. - my $warnit = 1; - if ($p =~ m,bin/([-a-z0-9]+)/,) { - if ($1 ne "$arch") { - # don't warn on specific platform patterns - $warnit = 0; - } - } - if ($p =~ m,/(\S+)\s+,) { - # that is an arch specific pattern - # don't warn if we the archs do not agree - $warnit = 0 if ($1 ne "$arch"); + my @todoarchs = $tltree->architectures; + my $finalp = $p; + if ($p =~ m%^(\w+)/(!?[-a-z0-9,]+)\s+(.*)$%) { + my $pt = $1; + my $aa = $2; + my $pr = $3; + if ($aa =~ m/^!(.*)$/) { + # negative specification + my %negarchs; + foreach (split(/,/,$1)) { + $negarchs{$_} = 1; } - if ($p =~ m,\$\{ARCH\}, && $arch eq "win32") { - # w32 fails to have many standard programs, don't complain - # about those either - $warnit = 0; + my @foo = (); + foreach (@todoarchs) { + push @foo, $_ unless defined($negarchs{$_}); } - if ($self->{name} =~ m/\.win32/ && $arch ne "win32") { - $warnit = 0; + @todoarchs = @foo; + } else { + @todoarchs = split(/,/,$aa); + } + # set $p to the pattern without arch specification + $finalp = "$pt $pr"; + } + # one final trick + # if the original pattern string matches bin/win32/ then we *only* + # work on the win32 arch + if ($finalp =~ m! bin/win32/!) { + @todoarchs = qw/win32/; + } + # now @todoarchs contains only those archs for which we want + # to match the pattern + foreach my $arch (@todoarchs) { + # get only those files matching the pattern + my @archfiles = $tltree->get_matching_files('bin',$finalp, $arch); + if (!@archfiles) { + if (($arch ne "win32") || defined($::win_pattern_warn)) { + tlwarn("$self->{name} ($arch): no hit on binpattern $finalp\n"); } - tlwarn("$self->{name} ($arch): no hit on binpattern $p\n") - if $warnit; } $tlp->add_binfiles($arch,@archfiles); } } foreach my $p (@allnegpats) { - my $matchref; - $matchref = $tltree->get_matching_files('bin',$p); - my %archmatches = %$matchref; - my @archs = $tltree->architectures; - foreach my $arch (@archs) { - my @archfiles = (); - if (defined($archmatches{$arch})) { - @archfiles = @{$archmatches{$arch}}; + my @todoarchs = $tltree->architectures; + my $finalp = $p; + if ($p =~ m%^(\w+)/(!?[-a-z0-9,]+)\s+(.*)$%) { + my $pt = $1; + my $aa = $2; + my $pr = $3; + if ($aa =~ m/^!(.*)$/) { + # negative specification + my %negarchs; + foreach (split(/,/,$1)) { + $negarchs{$_} = 1; + } + my @foo = (); + foreach (@todoarchs) { + push @foo, $_ unless defined($negarchs{$_}); + } + @todoarchs = @foo; + } else { + @todoarchs = split(/,/,$aa); } + # set $p to the pattern without arch specification + $finalp = "$pt $pr"; + } + # now @todoarchs contains only those archs for which we want + # to match the pattern + foreach my $arch (@todoarchs) { + # get only those files matching the pattern + my @archfiles = $tltree->get_matching_files('bin',$finalp, $arch); if (!@archfiles) { - tlwarn(" $self->{name} ($arch): no hit on negative binpattern $p\n"); - + if (($arch ne "win32") || defined($::win_pattern_warn)) { + tlwarn("$self->{name} ($arch): no hit on negative binpattern $finalp\n"); + } } $tlp->remove_binfiles($arch,@archfiles); } @@ -388,8 +411,7 @@ sub _do_normal_pattern { $is_default_pattern = 1; $p =~ s/^\*//; } - my $matchref = $tltree->get_matching_files($type,$p); - my @matchfiles = @$matchref; + my @matchfiles = $tltree->get_matching_files($type,$p); if (!$is_default_pattern && !@matchfiles && ($p !~ m/^f ignore/)) { tlwarn("$self->{name}: no hit for pattern $p\n"); } @@ -593,11 +615,12 @@ enables the font map file IC<.map> in the C file. enables the font map file IC<.map> for Mixed mode in the C file. -=item C +=item C -activates all the hyphenation patterns found in -C in the generated -C file. +activates the hyphenation pattern with name TEXLANG and load the file FILE +for that language. More variables can be given, currently: B, +B (both integers), and B (a list of alias names +for that hyphenation). =item C @@ -617,15 +640,15 @@ adds a pattern (see below) to the respective list of patterns. Patterns specify which files are to be included into a C at expansion time. Patterns are of the form - [PREFIX]TYPE[/ARCH] PAT + [PREFIX]TYPE[/[!]ARCHSPEC] PAT where PREFIX = + | +! | ! TYPE = t | f | d | r - ARCH = + ARCHSPEC = -Simple patterns without PREFIX and ARCH specification are explained first, +Simple patterns without PREFIX and ARCHSPEC specification are explained first, see below for these extensions. =over @@ -763,16 +786,30 @@ and would get C into the runfiles for C. Note that the C/C expansion B works for patterns of the C type! -=item ARCH specification of a pattern +=item ARCHSPEC specification of a pattern Sometimes some files should be included into the list of binfiles of -a package only for one architecture. This can be done by specifying -the architecture after the pattern specifier using a C: +a package only for some architectures, or for all but some architectures. +This can be done by specifying the list of architectures for which this +pattern should be matched after the pattern specifier using a C: binpattern f/win32 tlpkg/bin/perl.exe will include the file C only in the binfiles for -the architecture win32. +the architecture win32. Another example + + binpattern f/arch1,arch2,arch3 path/$ARCH/foo/bar + +will only try to match this pattern for arch1, arch2, and arch3. + +Normally, a binpattern is matched against all possible architectures. If you +want to exclude some architectures, instead of listing all the ones you want +to include as above, you can prefix the list of architectures with a ! and +these architectures will not be tested. Example: + + binpattern f/!arch1,arch2,arch3 path/$ARCH/foo/bar + +will be matched against all architectures I arch1, arch2, and arch3. =back 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 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)); } } -- cgit v1.2.3