TLPSRC.pm: check for unexpanded variables and more duplicate directives;

  simplify case statement handling lines.
TLTREE.pm (get_matching_files): propagate warnings from the eval,
  for the sake of undefined variables.
TLPDB.pm: doc.
tl-update-tlpdb: distinguish $tlpdb->writeout from $tlpdb->save in msg.


git-svn-id: svn://tug.org/texlive/trunk@48144 c570f23f-e606-0410-a88d-b1316a301751

4 files changed, 111 insertions, 94 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 25423f1a7b4..cfd5b2fa2fc 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -794,7 +794,7 @@ sub list_packages {
     }
     # we have to be careful here: If a package
     # is only present in a subsidiary repository
-    # and the package is *not* explicitely
+    # and the package is *not* explicitly
     # pinned to it, it will not be installable.
     # This is what we want. But in this case
     # we don't want it to be listed by default.
@@ -1066,7 +1066,7 @@ sub _generate_listfile {
         push @lop, $d;
       }
     } else {
-      # speudo dependencies on $Package.ARCH can be ignored
+      # pseudo-dependencies on $Package.ARCH can be ignored
       if ($d !~ m/\.ARCH$/) {
         tlwarn("TLPDB: package $tlp->name depends on $d, but this does not exist\n");
       }
@@ -1100,7 +1100,7 @@ sub _generate_listfile {
     print TMP "*Title: ", $tlp->shortdesc, "\n";
     my $s = 0;
     # schemes size includes ONLY those packages which are directly
-    # included and direclty included files, not the size of the
+    # included and directly included files, not the size of the
     # included collections. But if a package is included in one of
     # the called for collections AND listed directly, we don't want
     # to count its size two times
@@ -1260,7 +1260,7 @@ sub verification_status {
 =item C<< $tlpdb->listdir >>
 
 The function C<listdir> allows to read and set the packages variable
-specifiying where generated list files are created.
+specifying where generated list files are created.
 
 =cut
 
@@ -2064,7 +2064,7 @@ sub remove_package {
           } else {
             # NO NOTHING HERE!!!
             # DON'T PUSH IT ON @goodfiles, it will be removed, which we do
-            # NOT want. We only want to supress the warning!
+            # NOT want. We only want to suppress the warning!
             push @debugfiles, $f;
           }
         } else {
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm
index daee8923d5f..bab1da115a6 100644
--- a/Master/tlpkg/TeXLive/TLPSRC.pm
+++ b/Master/tlpkg/TeXLive/TLPSRC.pm
@@ -1,6 +1,6 @@
 # $Id$
 # TeXLive::TLPSRC.pm - module for handling tlpsrc files
-# Copyright 2007-2017 Norbert Preining
+# Copyright 2007-2018 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
@@ -12,19 +12,12 @@ use TeXLive::TLUtils;
 use TeXLive::TLPOBJ;
 use TeXLive::TLTREE;
 
-my $_tmp;
-my %autopatterns;  # computed once internally
-
 my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
-  $_modulerevision = $1;
-} else {
-  $_modulerevision = "unknown";
-}
-sub module_revision {
-  return $_modulerevision;
-}
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
+
+my $_tmp; # sorry
+my %autopatterns;  # computed once internally
 
 sub new {
   my $class = shift;
@@ -89,8 +82,7 @@ sub from_file {
   for my $line (@lines) {
     $lineno++;
     
-    # we allow continuation lines in tlpsrc files, i.e., lines with a \ at
-    # the end
+    # we allow continuation lines in tlpsrc files, i.e., lines ending with \.
     if ($line =~ /^(.*)\\$/) {
       $savedline .= $1;
       next;
@@ -104,75 +96,96 @@ sub from_file {
     $line =~ /^\s*#/ && next;          # skip comment lines
     next if $line =~ /^\s*$/;          # skip blank lines
     # (blank lines are significant in tlpobj, but not tlpsrc)
-
-    if ($line =~ /^ /) {
-      die "$srcfile:$lineno: non-continuation indentation not allowed: `$line'";
-    }
-    # remove terminal white space
+    #
+    $line =~ /^ /
+      && die "$srcfile:$lineno: non-continuation indentation not allowed: `$line'";
+    #
+    # remove trailing white space.
     $line =~ s/\s+$//;
+
+    # expand tlpvars while reading in (except in descriptions).
+    # that means we have to respect *order* and define variables
+    # as we read the tlpsrc file.
+    if ($line !~ /^(short|long)desc\s/) {
+      for my $k (keys %tlpvars) {
+        $line =~ s/\$\{\Q$k\E\}/$tlpvars{$k}/g;
+      }
+      # check that no variables remain unexpanded, or rather, for any
+      # remaining $ (which we don't otherwise allow in tlpsrc files, so
+      # should never occur) ... except for ${ARCH} and ${PKGNAME} which
+      # we specially expand. (Sigh: we distribute one file dvi$pdf.bat, but
+      # fortunately we match it with a directory.)
+      # 
+      (my $testline = $line) =~ s,\$\{(ARCH|PKGNAME)\},,g;
+      $testline =~ /\$/
+        && die "$srcfile:$lineno: variable undefined or syntax error: $line\n";
+    } # end variable expansion.
+
     # names of source packages can either be
     # - normal names: ^[-\w]+$
     # - win32 specific packages: ^[-\w]+\.win32$
     # - normal texlive specific packages: ^texlive.*\..*$
     # - configuration texlive specific packages: ^00texlive.*\..*$
-    if ($line =~ /^name\s*([-\w]+(\.win32)?|00texlive.*|texlive\..*)$/) {
+    if ($line =~ /^name\s/) {
+      $line =~ /^name\s+([-\w]+(\.win32)?|(00)?texlive\..*)$/;
+      $foundnametag 
+        && die "$srcfile:$lineno: second name directive not allowed: $line"
+               . "(have $name)\n";
       $name = $1;
-      $foundnametag && die "$srcfile: second name directive not allowed: $name";
       $foundnametag = 1;
+
+    } elsif ($line =~ /^category\s+$CategoriesRegexp$/) {
+      $category = $1;
+
+    } elsif ($line =~ /^shortdesc\s*(.*)$/) {
+      # although we would like to do this, hyphen-latin.tlpsrc contains
+      # multiple short/longdesc entries. Not worth following up.
+      # $shortdesc
+      #   && die "$srcfile:$lineno: second shortdesc not allowed: $line"
+      #          . "(have $shortdesc)\n";
+      $shortdesc = $1;
+
+    } elsif ($line =~ /^shortdesc$/) {
+      $shortdesc = "";
+
+    } elsif ($line =~ /^longdesc$/) {
+      $longdesc .= "\n";
+
+    } elsif ($line =~ /^longdesc\s+(.*)$/) {
+      $longdesc .= "$1 ";
+
+    } elsif ($line =~ /^catalogue\s+(.*)$/) {
+      $catalogue
+        && die "$srcfile:$lineno: second catalogue not allowed: $line"
+               . "(have $catalogue)\n";
+      $catalogue = $1;
+
+    } elsif ($line =~ /^runpattern\s+(.*)$/) {
+      push (@runpatterns, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^srcpattern\s+(.*)$/) {
+      push (@srcpatterns, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^docpattern\s+(.*)$/) {
+      push (@docpatterns, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^binpattern\s+(.*)$/) {
+      push (@binpatterns, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^execute\s+(.*)$/) {
+      push (@executes, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^depend\s+(.*)$/) {
+      push (@depends, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^postaction\s+(.*)$/) {
+      push (@postactions, $1) if ($1 ne "");
+
+    } elsif ($line =~ /^tlpsetvar\s+([-_a-zA-Z0-9]+)\s+(.*)$/) {
+      $tlpvars{$1} = $2;
+
     } else {
-      # expand tlpvars while reading in
-      # that means we have to respect *order* and define variables
-      # first in the tlpsrc file
-      for my $k (keys %tlpvars) {
-        $line =~ s/\$\{\Q$k\E\}/$tlpvars{$k}/g;
-      }
-      # we default to the file name as package name
-      # $started || die "$srcfile: first directive must be `name', not $line";
-      if ($line =~ /^shortdesc\s*(.*)$/) {
-        $shortdesc = $1;
-        next;
-      } elsif ($line =~ /^shortdesc$/) {
-        $shortdesc = "";
-        next;
-      } elsif ($line =~ /^category\s+$CategoriesRegexp$/) {
-        $category = $1;
-        next;
-      } elsif ($line =~ /^longdesc$/) {
-        $longdesc .= "\n";
-        next;
-      } elsif ($line =~ /^longdesc\s+(.*)$/) {
-        $longdesc .= "$1 ";
-        next;
-      } elsif ($line =~ /^catalogue\s+(.*)$/) {
-        $catalogue = $1;
-        next;
-      } elsif ($line =~ /^runpattern\s+(.*)$/) {
-        push @runpatterns, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^srcpattern\s+(.*)$/) {
-        push @srcpatterns, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^docpattern\s+(.*)$/) {
-        push @docpatterns, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^binpattern\s+(.*)$/) {
-        push @binpatterns, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^execute\s+(.*)$/) {
-        push @executes, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^depend\s+(.*)$/) {
-        push @depends, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^postaction\s+(.*)$/) {
-        push @postactions, $1 if ($1 ne "");
-        next;
-      } elsif ($line =~ /^tlpsetvar\s+([-_a-zA-Z0-9]+)\s+(.*)$/) {
-        $tlpvars{$1} = $2;
-        next;
-      } else {
-        tlwarn("$srcfile:$lineno: unknown tlpsrc directive, fix fix: $line\n");
-      }
+      die "$srcfile:$lineno: unknown tlpsrc directive, fix: $line\n";
     }
   }
   $self->_srcfile($srcfile);
@@ -1042,8 +1055,8 @@ ease the writing of patterns, we have the following:
 
 =item Architecture expansion
 
-In case the string C<${>I<ARCH>} occurs in one C<binpattern> it is
-automatically expanded to the respective architecture.
+Within a binpattern, the string C<${ARCH}> is automatically expanded to
+all available architectures.
 
 =item C<bat/exe/dll/texlua> for Windows
 
diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm
index 5b67de191d1..95d304b18e7 100644
--- a/Master/tlpkg/TeXLive/TLTREE.pm
+++ b/Master/tlpkg/TeXLive/TLTREE.pm
@@ -7,12 +7,7 @@
 package TeXLive::TLTREE;
 
 my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
-  $_modulerevision = $1;
-} else {
-  $_modulerevision = "unknown";
-}
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
 sub module_revision { return $_modulerevision; }
 
 use TeXLive::TLUtils;
@@ -326,11 +321,20 @@ sub get_matching_files {
   my $ARCH = $arch;
   my $PKGNAME = $pkg;
   my $newp;
-  eval "\$newp = \"$p\"";
-  if (!defined($newp)) {
-    print "Huuu: cannot generate newp from p: p=$p, pkg=$pkg, arch=$arch, type=$type\n";
+  {
+    my $warnstr = "";
+    local $SIG{__WARN__} = sub { $warnstr = $_[0]; };
+    eval "\$newp = \"$p\"";
+    if (!defined($newp)) {
+      die "cannot set newp from p: p=$p, pkg=$pkg, arch=$arch, type=$type";
+    }
+    if ($warnstr) {
+      tlwarn("Warning `$warnstr' while evaluating: $p "
+             . "(pkg=$pkg, arch=$arch, type=$type), returning empty list\n");
+      return ();
+    }
   }
-  return($self->_get_matching_files($type,$newp));
+  return $self->_get_matching_files($type,$newp);
 }
 
   
diff --git a/Master/tlpkg/bin/tl-update-tlpdb b/Master/tlpkg/bin/tl-update-tlpdb
index 5415d7d1cbe..a43baa6e08e 100755
--- a/Master/tlpkg/bin/tl-update-tlpdb
+++ b/Master/tlpkg/bin/tl-update-tlpdb
@@ -445,13 +445,13 @@ sub finish {
   if ($opt_output) {
     if (open(OUT, ">$opt_output")) {
       $tlpdb->writeout(\*OUT);
-      info ("$progname: wrote $pkgcount packages to $opt_output.\n");
+      info ("$progname: output $pkgcount packages to $opt_output.\n");
     } else {
       tldie ("$progname: open(>$opt_output) failed: $!");
     }
   } else {
     $tlpdb->save;
-    info ("$progname: wrote $pkgcount packages to " . $tlpdb->root . ".\n");
+    info ("$progname: saved $pkgcount packages to " . $tlpdb->root . ".\n");
   }
   exit (0);
 }