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

4 files changed, 127 insertions, 91 deletions

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 I<font>C<.map> in the C<updmap.cfg> file.
 enables the font map file I<font>C<.map> for Mixed mode in the
 C<updmap.cfg> file.
 
-=item C<execute BuildLanguageDat NN>
+=item C<execute AddHyphen name=TEXLANG file=FILE [other vars]>
 
-activates all the hyphenation patterns found in 
-C<Master/texmf/tex/generic/config/language.NN.dat> in the generated
-C<language.dat> file.
+activates the hyphenation pattern with name TEXLANG and load the file FILE
+for that language. More variables can be given, currently: B<lefthyphenmin>,
+B<righthyphenmin> (both integers), and B<synonyms> (a list of alias names
+for that hyphenation).
 
 =item C<execute BuildFormat FMTCFG>
 
@@ -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<tlpobj> at
 expansion time. Patterns are of the form
 
-  [PREFIX]TYPE[/ARCH] PAT
+  [PREFIX]TYPE[/[!]ARCHSPEC] PAT
 
 where
 
   PREFIX = + | +! | !
   TYPE = t | f | d | r
-  ARCH = <some arch specificatin>
+  ARCHSPEC = <list of architectures separated by comma>
 
-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<bin/win32/dvips.exe> into the runfiles for C<arch=win32>.
 Note that the C<bat>/C<exe> expansion B<only> works for patterns of
 the C<f> 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<tlpkg/bin/perl.exe> 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<but> 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<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));
   }
 }
 
diff --git a/Master/tlpkg/bin/tlpsrc2tlpdb b/Master/tlpkg/bin/tlpsrc2tlpdb
index 7fa316d7ea4..127e365bc5d 100755
--- a/Master/tlpkg/bin/tlpsrc2tlpdb
+++ b/Master/tlpkg/bin/tlpsrc2tlpdb
@@ -29,6 +29,7 @@ my $opt_catalogue = "";
 chomp (my $opt_master = `cd $::mydir/../.. && pwd`);
 my $help = 0;
 my $opt_nobinsplit = 0;
+my $opt_winwarning;
 
 TeXLive::TLUtils::process_logging_options();
 GetOptions(
@@ -36,6 +37,7 @@ GetOptions(
     "master=s" => \$opt_master,	# location of the TL tree
     "catalogue=s" => \$opt_catalogue, # location of the TeX Catalogue
     "no-bin-split!" => \$opt_nobinsplit,
+    "with-win-pattern-warning" => \$opt_winwarning,
     "help|?" => \$help) or pod2usage(1);
 pod2usage(-exitstatus => 0, -verbose => 2) if $help;
 
@@ -47,7 +49,9 @@ sub main
   if (! -d $opt_master) {
     die "$0: Master $opt_master not a directory, goodbye.\n";
   }
-
+  if (defined($opt_winwarning)) {
+    $::win_pattern_warn = 1;
+  }
   my $tlc = undef;
   if (! -d $opt_catalogue) {
     info ("$0: -c /Cat/a/logue not given, continuing without it.\n");
@@ -162,6 +166,12 @@ Do NOT split files with binaries into several packages (one for the arch
 independent and one for each of the architectures with only the respective
 binaries).  There is no reason to use this option.
 
+=item B<-with-win-pattern-warning>
+Normally, this program issues a warning for all patterns without a matching
+file, but does I<not> warn for binpatterns when working on the win32 
+architecture. Giving this option makes it issues all warnings, i.e., also
+those where a binpattern on win32 does not hit.
+
 =back
 
 The standard options C<-help> and C<-debug> are also accepted.