From c0df6a1395f65645200563c3586fb2c4b73e0630 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Thu, 5 Jul 2018 18:05:05 +0000 Subject: 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 --- Master/tlpkg/TeXLive/TLPDB.pm | 10 +-- Master/tlpkg/TeXLive/TLPSRC.pm | 167 +++++++++++++++++++++------------------ Master/tlpkg/TeXLive/TLTREE.pm | 24 +++--- Master/tlpkg/bin/tl-update-tlpdb | 4 +- 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 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} occurs in one C it is -automatically expanded to the respective architecture. +Within a binpattern, the string C<${ARCH}> is automatically expanded to +all available architectures. =item C 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); } -- cgit v1.2.3