From 2ead7e2006fba7e2ede813415f6eb409edf4c6c4 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 4 Mar 2020 02:40:21 +0000 Subject: tl-update-tlpdbs (compare_and_fix_tlpdbs): do not return prematurely if set of packages is the same; may also need to check catalogue data. Doc. TLTREE.pm (_get_files_matching_glob_pattern): switch to dddebug for the matching and hits, else -vv output from tl-update-tlpdb is unusably voluminous. TLUtils.pm (dddebug): document this. git-svn-id: svn://tug.org/texlive/trunk@54067 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLTREE.pm | 6 +-- Master/tlpkg/TeXLive/TLUtils.pm | 8 +-- Master/tlpkg/bin/tl-update-tlpdb | 104 +++++++++++++++++++-------------------- 3 files changed, 59 insertions(+), 59 deletions(-) (limited to 'Master') diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm index 752ddf7fc91..535dd435f5e 100644 --- a/Master/tlpkg/TeXLive/TLTREE.pm +++ b/Master/tlpkg/TeXLive/TLTREE.pm @@ -1,6 +1,6 @@ # $Id$ # TeXLive::TLTREE.pm - work with the tree of all files -# Copyright 2007-2018 Norbert Preining +# Copyright 2007-2020 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -385,9 +385,9 @@ sub _get_files_matching_glob_pattern my @candfiles = @{$self->{'_filesofdir'}{$dirpart}}; for my $f (@candfiles) { - ddebug("matching $f in $dirpart via glob $globline\n"); + dddebug("matching $f in $dirpart via glob $globline\n"); if ($f =~ /^$basepart$/) { - ddebug("hit: globline=$globline, $dirpart/$f\n"); + dddebug("hit: globline=$globline, $dirpart/$f\n"); if ("$dirpart" eq ".") { push @returnfiles, "$f"; } else { diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 409304c980f..ae4c2c282ef 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -3419,9 +3419,11 @@ strings. The message will be omitted unless C<-v -v -v> was specified. If the log file (see L) is defined, it also writes there. -This third level debugging message reports messages about processing -each line of any tlpdb files read, in addition to the first and second -levels. +In addition to the first and second levels, this third level debugging +message reports messages about processing each line of any tlpdb files +read, and messages about files tested or matched against tlpsrc +patterns. This output is extremely voluminous, so unless you're +debugging those parts of the code, it just gets in the way. =cut diff --git a/Master/tlpkg/bin/tl-update-tlpdb b/Master/tlpkg/bin/tl-update-tlpdb index e118c0e1f96..02a7a7d08a2 100755 --- a/Master/tlpkg/bin/tl-update-tlpdb +++ b/Master/tlpkg/bin/tl-update-tlpdb @@ -13,7 +13,7 @@ BEGIN { } use strict; -use experimental qw(smartmatch); # what the heck +use experimental qw(smartmatch); # what the heck, see ~~ below use TeXLive::TLConfig; use TeXLive::TLPSRC; @@ -145,7 +145,8 @@ sub main { # then we recreate the tlpdb, else we will report as buggy. # if (!$opt_fromfiles && $opt_fix_reverse_revisions && !$opt_no_commit) { - info("$prg: Regenerating tlpdb after fixing\n"); + info("$prg: Regenerating tlpdb after fixing, " + . "without -fix-reverse-revisions\n"); ($newtlpdb,$pkgcount) = create_tlpdb($tlc); # # now recheck, but do NOT try to check in changes again, since it @@ -205,55 +206,54 @@ sub copy_revisions_over { # Compare OLDTLPDB and NEWTLPDB, returning whether any packages needed # special fixing. Within the list of packages that differ, the -# problematic ones are where there are either files added or removed, or -# Catalogue changes (against --catalogue-compare) but the revision did -# not increase. +# problematic ones are those where either files were added or removed, +# or there were Catalogue changes (against --catalogue-compare) but the +# revision did not increase. # # If a package has been removed or added (or not changed at all) that is # fine for here, as it will be dealt with in tl-update-containers. # sub compare_and_fix_tlpdbs { my ($oldtlpdb,$newtlpdb) = @_; - - my %cmp = TeXLive::TLUtils::compare_tlpdbs($oldtlpdb, $newtlpdb); - my %packages_needing_fixup; - return unless defined($cmp{'different_packages'}); - for my $p (sort keys %{$cmp{'different_packages'}}) { - if (defined($cmp{'different_packages'}->{$p}->{'added'}) || - defined($cmp{'different_packages'}->{$p}->{'removed'})) { - if (!defined($cmp{'different_packages'}->{$p}->{'revision'})) { - # no revision change reported, but files have been added - # or removed, try fixing it - $packages_needing_fixup{$p} = 1; - } else { - # revision change has been reported, if the revision is increasing - # that is fine, otherwise try fixing it - my ($rA, $rB) = split(':', - $cmp{'different_packages'}->{$p}->{'revision'}); - if ($rA >= $rB) { + my %cmp = TeXLive::TLUtils::compare_tlpdbs($oldtlpdb, $newtlpdb); + if (exists $cmp{'different_packages'}) { + for my $p (sort keys %{$cmp{'different_packages'}}) { + if (defined($cmp{'different_packages'}->{$p}->{'added'}) || + defined($cmp{'different_packages'}->{$p}->{'removed'})) { + if (!defined($cmp{'different_packages'}->{$p}->{'revision'})) { + # no revision change reported, but files have been added + # or removed, try fixing it $packages_needing_fixup{$p} = 1; + } else { + # revision change has been reported, if the revision is increasing + # that is fine, otherwise try fixing it + my ($rA, $rB) = split(':', + $cmp{'different_packages'}->{$p}->{'revision'}); + if ($rA >= $rB) { + $packages_needing_fixup{$p} = 1; + } } - } - } else { - # there have been no changed filelists, but we still check that - # revision is not going backward for some other strange reason. - if (defined($cmp{'different_packages'}->{$p}->{'revision'})) { - # revision change has been reported, if the revision is increasing - # that is fine, otherwise try fixing it - my ($rA, $rB) = split(':', - $cmp{'different_packages'}->{$p}->{'revision'}); - # since we only register 'revision' key when there is a - # change, we have either rA < rB or rA > rB - if ($rA > $rB) { - tlwarn("$prg: big warning for $p: file lists didn't change " - . "but revision is going backward! Very strange!\n"); - $packages_needing_fixup{$p} = 1; - } # if strange revision change - } # no revision changes - } # not (added or removed) - } # loop through differing packages + } else { + # there have been no changed filelists, but we still check that + # revision is not going backward for some other strange reason. + if (defined($cmp{'different_packages'}->{$p}->{'revision'})) { + # revision change has been reported, if the revision is increasing + # that is fine, otherwise try fixing it + my ($rA, $rB) = split(':', + $cmp{'different_packages'}->{$p}->{'revision'}); + # since we only register 'revision' key when there is a + # change, we have either rA < rB or rA > rB + if ($rA > $rB) { + tlwarn("$prg: big warning for $p: file lists didn't change " + . "but revision is going backward! Very strange!\n"); + $packages_needing_fixup{$p} = 1; + } # if strange revision change + } # no revision changes + } # not (added or removed) + } # loop through differing packages + } # no different_packages # if requested, also may need to fix up packages with catalogue changs. if ($opt_catalogue_compare) { @@ -282,7 +282,7 @@ sub compare_and_fix_tlpdbs { my $tlp = $newtlpdb->get_package($p); if (!defined($tlp)) { tlwarn("Very strange, $p is mentioned as changed files,\n"); - tlwarn("but it is not found in new tlppdb.\n"); + tlwarn("but it is not found in new tlpdb.\n"); tlwarn("Not trying to fix anything, don't know how!\n"); next; } @@ -472,7 +472,6 @@ sub create_tlpdb { return($tldb, $src_count); } - # Compare Catalogue data (and nothing else) in MASTER_TLPDB to the tlpdb # found in CMP_TLPDB_STR. Return hash (only keys matter, values are 1) @@ -538,24 +537,24 @@ sub tlpobj_catalogue_equal { my $ret = 0; my $pkg = $tlpA->name; # just for debugging output - ddebug("$pkg: comparing catalogue info:\n"); + debug("$pkg: comparing catalogue info:\n"); # the shortdesc and longdesc usually come from the Catalogue, # so are not in the tlpsrc. if (! &equal_strings($tlpA->shortdesc, $tlpB->shortdesc)) { - ddebug("$pkg: shortdesc changed\n"); + debug("$pkg: shortdesc changed\n"); } elsif (! &equal_strings($tlpA->longdesc, $tlpB->longdesc)) { - ddebug("$pkg: longdesc changed\n"); + debug("$pkg: longdesc changed\n"); } elsif (! &equal_strings($tlpA->catalogue, $tlpB->catalogue)) { - ddebug("$pkg: catalogue value changed\n"); + debug("$pkg: catalogue value changed\n"); } elsif (! &equal_hashes($tlpA->cataloguedata, $tlpB->cataloguedata)) { - ddebug("$pkg: cataloguedata changed\n"); + debug("$pkg: cataloguedata changed\n"); } elsif (! &equal_hashes($tlpA->docfiledata, $tlpB->docfiledata)) { - ddebug("$pkg: docfiledata changed\n"); + debug("$pkg: docfiledata changed\n"); } else { $ret = 1; # seems there were no Catalogue changes. @@ -564,9 +563,8 @@ sub tlpobj_catalogue_equal { return $ret; } - -# Return true if A and B are the same strings : both undef, or both +# Return true if A and B are the same strings: both undef, or both # defined and eq. (Writing out the defined tests each time is too annoying.) # sub equal_strings { @@ -590,13 +588,13 @@ sub equal_hashes { # both must be hash references. if (! (&is_hash_ref($h1) && &is_hash_ref($h2))) { - ddebug(" not both hash ref: $h1 vs. $h2\n"); + debug(" not both hash ref: $h1 vs. $h2\n"); return 0; } # must have the same keys (smartmatch operator). if (! (%$h1 ~~ %$h2)) { - ddebug(" keys not equal:", join("|", keys %$h1), " vs. ", + debug(" keys not equal:", join("|", keys %$h1), " vs. ", join("|", keys %$h2), "\n"); return 0; } -- cgit v1.2.3