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

1 files changed, 51 insertions, 53 deletions

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;
   }