tl-update-tlpdb: new option --catalogue-compare for (ultimately) forcing

  new revisions on Catalogue updates wrt tlnet; will run occasionally
  from cron.
(tlpdb_catalogue_compare, tlpobj_catalogue_equal, equal_strings,
  equal_hashes, is_hash_ref): new fns to implement it.

(compare_and_fix_tlpdbs): rename main hash %cmp from %ret, since it is
  not what gets returned. Return early if no different_packages data.
(copy_revision_over): rename from move_revisions_over, since orig is untouched.

TeXCatalogue.pm (initialize): use XML::XPath::findvalue instead of
  find(), so we end up with a string, not (potentially, e.g.,
  contact-home) an XML::XPath::NodeSet, which overloads the comparison
  operators in an unusual (buggy?) way.
  https://rt.cpan.org/Ticket/Display.html?id=131114


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

2 files changed, 382 insertions, 148 deletions

diff --git a/Master/tlpkg/TeXLive/TeXCatalogue.pm b/Master/tlpkg/TeXLive/TeXCatalogue.pm
index 273863202f3..ff21c719e3b 100644
--- a/Master/tlpkg/TeXLive/TeXCatalogue.pm
+++ b/Master/tlpkg/TeXLive/TeXCatalogue.pm
@@ -1,10 +1,10 @@
 # $Id$
 # TeXLive::TeXCatalogue - module for accessing the TeX Catalogue
-# Copyright 2007-2018 Norbert Preining
+# Copyright 2007-2019 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 # 
-# Loads of code taken from the catalogue checking script of Robin Fairbairns.
+# Loads of code adapted from the catalogue checking script of Robin Fairbairns.
 
 use XML::Parser;
 use XML::XPath;
@@ -14,15 +14,27 @@ use Text::Unidecode;
 package TeXLive::TeXCatalogue::Entry;
 
 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; }
+
+=pod
+
+=head1 NAME
+
+TeXLive::TeXCatalogue - accessing the TeX Catalogue for TeX Live
+
+=head1 SYNOPSIS
+
+missing
+
+=head1 DESCRIPTION
+
+The L<TeXLive::TeXCatalogue> module provides access to the data stored
+in the TeX Catalogue.
+
+DOCUMENTATION MISSING, SORRY!!!
+
+=cut
 
 my $_parser = XML::Parser->new(
   ErrorContext => 2,
@@ -106,16 +118,16 @@ sub initialize {
   }
   # parse the contact entries
   foreach my $node ($parser->find('/entry/contact')->get_nodelist) {
-    my $contacttype = $parser->find('./@type',$node);
-    my $contacthref = $parser->find('./@href',$node);
+    my $contacttype = $parser->findvalue('./@type',$node);
+    my $contacthref = $parser->findvalue('./@href',$node);
     if ($contacttype && $contacthref) {
       $self->{'contact'}{$contacttype} = $contacthref;
     }
   }
   # parse the keyval/topic entries
   foreach my $node ($parser->find('/entry/keyval')->get_nodelist) {
-    my $k = $parser->find('./@key',$node);
-    my $v = $parser->find('./@value',$node);
+    my $k = $parser->findvalue('./@key',$node);
+    my $v = $parser->findvalue('./@value',$node);
     # for now we only support evaluating the 'topic' key
     if ("$k" eq 'topic') {
       push @{$self->{'topic'}}, "$v";
@@ -309,20 +321,11 @@ sub entries {
 __END__
 
 
-=head1 NAME
-
-TeXLive::TeXCatalogue - Accessing the TeX Catalogue
-
-=head1 SYNOPSIS
+=head1 SEE ALSO
 
-missing
-
-=head1 DESCRIPTION
-
-The L<TeXLive::TeXCatalogue> module provides access to the data stored
-in the TeX Catalogue.
-
-DOCUMENTATION MISSING, SORRY!!!
+The other modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and
+the rest), and the scripts in C<Master/tlpg/bin/> (especially
+C<tl-update-tlpdb>), the documentation in C<Master/tlpkg/doc/>, etc.
 
 =head1 AUTHORS AND COPYRIGHT
 
diff --git a/Master/tlpkg/bin/tl-update-tlpdb b/Master/tlpkg/bin/tl-update-tlpdb
index 987cdadeb67..b59feb30da6 100755
--- a/Master/tlpkg/bin/tl-update-tlpdb
+++ b/Master/tlpkg/bin/tl-update-tlpdb
@@ -1,6 +1,6 @@
 #!/usr/bin/env perl
 # $Id$
-# convert a set of tlpsrc files (given as arguments) into tlpdb
+# Convert a TL tree and *.tlpsrc files into a (possibly updated) texlive.tlpdb.
 # 
 # Copyright 2007-2019 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
@@ -12,7 +12,8 @@ BEGIN {
   unshift (@INC, "$mydir/..");
 }
 
-use strict;
+use strict; use warnings;
+use experimental qw(smartmatch); # what the heck
 
 use TeXLive::TLConfig;
 use TeXLive::TLPSRC;
@@ -26,39 +27,41 @@ use Pod::Usage;
 use File::Path;
 
 my $opt_catalogue = "";
-chomp (my $opt_master = `cd $::mydir/../.. && pwd`);
-my $help = 0;
+my $opt_catalogue_compare = "";
 my $opt_dry_run = 0;
 my $opt_fix_reverse_revisions = 0;  # needs svn commit
 my $opt_fromfiles = 0;
 my $opt_fromgit = 0;
 my $opt_fromgitsvn = 0;
+my $opt_keep_revisions = 0;
+chomp (my $opt_master = `cd $::mydir/../.. && pwd`);
+my $opt_no_binsplit = 0;
 my $opt_no_commit = 0; # do/don't commit the changes
-my $opt_no_revision_check = 0;
-my $opt_nobinsplit = 0;
+my $opt_no_revision_check = undef; # set depending on options, if not explicit.
 my $opt_output;
 my $opt_save_anyway = 0;
 my $opt_tlpsrc_from_cmdline = 0;
 my $opt_w32warning;
-my $opt_keep_revisions = 0;
+my $help = 0;
 
 TeXLive::TLUtils::process_logging_options();
 GetOptions(
     "catalogue=s"                => \$opt_catalogue,
+    "catalogue-compare=s"        => \$opt_catalogue_compare,
     "dry-run|n",                 => \$opt_dry_run,
     "fix-reverse-revisions!"     => \$opt_fix_reverse_revisions,
-    "keep-revisions"             => \$opt_keep_revisions,
     "from-files"                 => \$opt_fromfiles,
     "from-git"                   => \$opt_fromgit,
     "from-gitsvn"                => \$opt_fromgitsvn,
+    "keep-revisions"             => \$opt_keep_revisions,
     "master=s"                   => \$opt_master,
-    "no-bin-split!"              => \$opt_nobinsplit,
+    "no-bin-split!"              => \$opt_no_binsplit,
     "no-commit!"                 => \$opt_no_commit,
     "no-reverse-revision-check!" => \$opt_no_revision_check,
     "output=s"                   => \$opt_output,
     "save-anyway!"               => \$opt_save_anyway,
     "tlpsrc-from-cmdline"        => \$opt_tlpsrc_from_cmdline,
-    "with-w32-pattern-warning"   => \$opt_w32warning,
+    "w32-pattern-warning!"       => \$opt_w32warning,
     "help|?" => \$help) or pod2usage(1);
 pod2usage(-exitstatus => 0, -verbose => 2) if $help;
 
@@ -71,17 +74,22 @@ sub main {
   if (! -d $opt_master) {
     die "$progname: Master $opt_master not a directory, goodbye.\n";
   }
-
   if ($opt_fromfiles + $opt_fromgit + $opt_fromgitsvn > 1) {
     die "$progname: only one option --from[lines|git|gitsvn] can be given.\n";
   }
 
-  $opt_catalogue = "/home/httpd/html/catalogue"
-    if ! $opt_catalogue;
+  if (! $opt_catalogue) {
+    $opt_catalogue = "/home/httpd/html/catalogue";
+  }
 
+  if ($opt_catalogue_compare) {
+    $opt_no_revision_check = 0 unless defined $opt_no_revision_check;
+  }
+  
   if ($opt_dry_run) {
     $opt_no_commit = 1;
-    $opt_no_revision_check = 1;
+    $opt_fix_reverse_revisions = 0;
+    $opt_no_revision_check = 1 unless defined $opt_no_revision_check;
     $opt_output = "/tmp/tlut" if ! $opt_output;
   }
   
@@ -92,50 +100,58 @@ sub main {
   } else {
     tlwarn("$progname: reusing Catalogue data, since source is not readable: "
            . "$opt_catalogue\n");
+    if ($opt_catalogue_compare) {
+      tlwarn("$progname: unsetting --catalogue-compare since no Catalogue\n");
+      $opt_catalogue_compare = "";
+    }
   }
 
   # Create our working tlpdb with Catalogue data.
   my ($newtlpdb,$pkgcount) = create_tlpdb($tlc);
 
+  my $tlpdb_loc = "$TeXLive::TLConfig::InfraLocation"
+                  . "/$TeXLive::TLConfig::DatabaseName";
   my $oldtlpdb = undef;
-  my $OLDTLPDB = "$opt_master/$TeXLive::TLConfig::InfraLocation/texlive.tlpdb";
+  my $OLDTLPDB = "$opt_master/$tlpdb_loc";
   if (-r $OLDTLPDB) {
     $oldtlpdb = TeXLive::TLPDB->new ("root" => $opt_master);
   }
   if (!defined($oldtlpdb)) {
-    tlwarn ("$progname: No revision check, no old tlpdb: $OLDTLPDB\n");
+    tlwarn ("$progname: No revision check since no old tlpdb: $OLDTLPDB\n");
     finish ($newtlpdb, $pkgcount);
   }
 
   if ($opt_no_revision_check) {
     if ($opt_keep_revisions) {
-      move_revisions_over($oldtlpdb, $newtlpdb);
+      copy_revisions_over($oldtlpdb, $newtlpdb);
       info ("$progname: Keeping old revisions due to --keep-revisions\n");
     } else {
       info ("$progname: Not checking revisions due to --no-reverse-revision-check\n");
     }
     finish ($newtlpdb, $pkgcount);
   }
-  # compare_tlpdbs returns true if some reversed revisions have been found.
-  # If in addition the option --fix-reverse-revisions is given it tries
-  # to fix that, by committing changes.
+
+  # compare_and_fix_tlpdbs returns true if any reversed revisions were found.
+  # If the option --fix-reverse-revisions (etc.) specify, it also tried
+  # to fix them, by committing changes.
   my $buggy_tlpdb = 0;
   if (compare_and_fix_tlpdbs($oldtlpdb, $newtlpdb)) {
     $buggy_tlpdb = 1;
-    # there have been reversed revision that have already been warned about
-    # and that have been (hopefully) fixed by compared_tlpdbs if
-    # --fix-reverse-revisions has been given
     #
-    # if we are running from svn (no --from-files is given) and we try
-    # to fix revisions (--fix-reverse-revisions is given), and we do
-    # commit the changes (--no_commit is not given), then we recreate the tlpdb
+    # There have been reversed revisions that have already been warned about
+    # and that have been (hopefully) fixed by compare_and_fix_tlpdbs.
+    #
+    # If we are running from svn (--from-files is not given),
+    # and we tried to fix revisions (--fix-reverse-revisions is given),
+    # and we are committing the changes (--no_commit is not given),
+    # then we recreate the tlpdb, else we will report as buggy.
     #
     if (!$opt_fromfiles && $opt_fix_reverse_revisions && !$opt_no_commit) {
       info ("$progname: Regenerating tlpdb after fixing\n");
-      ($newtlpdb, $pkgcount) = create_tlpdb($tlc);
+      ($newtlpdb,$pkgcount) = create_tlpdb($tlc);
       #
-      # now recheck, but do NOT try to check in changes again by unsetting
-      # $opt_fix_reverse_revisions
+      # now recheck, but do NOT try to check in changes again, since it
+      # already failed: forcibly unset $opt_fix_reverse_revisions.
       $opt_fix_reverse_revisions = 0;
       if (compare_and_fix_tlpdbs($oldtlpdb, $newtlpdb)) {
         tlwarn ("$progname: *** oops, should not happen!\n"
@@ -149,17 +165,18 @@ sub main {
       }
     }
   }
-  # new $newtlpdb points to the right one
+  
+  # $newtlpdb points to the right one
   if ($buggy_tlpdb) {
     tlwarn("$progname: the newly created tlpdb seems to be buggy.\n");
     if ($opt_output) {
-      tlwarn("$progname: saving it anyway due to --output given\n");
+      tlwarn("$progname: saving it anyway due to --output (to $opt_output)\n");
       $buggy_tlpdb = 0;
     } elsif ($opt_save_anyway) {
       tlwarn("$progname: saving it anyway due to --save-anyway\n");
       $buggy_tlpdb = 0;
     } else {
-      tlwarn("$progname: not saving it, you might use --save-anyway\n");
+      tlwarn("$progname: not saving it, use --save-anyway if you want it\n");
     }
   }
   if (!$buggy_tlpdb) {
@@ -171,78 +188,96 @@ sub main {
 }
 
 
-sub move_revisions_over {
+# Set the revision of each package in NEWTLPDB
+# to its revision in OLDTLPDB (if the pkg exists in OLDTLPDB).
+# 
+sub copy_revisions_over {
   my ($oldtlpdb, $newtlpdb) = @_;
   for my $pkg ($newtlpdb->list_packages) {
     my $oldtlp = $oldtlpdb->get_package($pkg);
     if (defined($oldtlp)) {
+      my $oldrev = $oldtlp->revision;
+      my $newrev = $newtlpdb->get_package($pkg)->revision;
+      warn "xxxpkg $pkg: changing revision from $newrev to $oldrev\n";
       $newtlpdb->get_package($pkg)->revision($oldtlp->revision);
     }
   }
 }
 
 
+# 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.
+# 
+# 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 %ret = TeXLive::TLUtils::compare_tlpdbs($oldtlpdb, $newtlpdb);
-
-  # we only care for differences in packages. If a packages has been
-  # removed or added that is fine for here as this will be dealt with
-  # in tl-update-containers
-
-  # within the list of packages that differ the problematic ones are
-  # where there are either files added or removed, but the revision
-  # did not increase
-
-  my %packages_that_need_fixup;
-
-  if (defined($ret{'different_packages'})) {
-    for my $p (keys %{$ret{'different_packages'}}) {
-      if (defined($ret{'different_packages'}->{$p}->{'added'}) ||
-          defined($ret{'different_packages'}->{$p}->{'removed'})) {
-        if (!defined($ret{'different_packages'}->{$p}->{'revision'})) {
-          # no revision change reported, but files have been added
-          # or removed, try fixing it
-          $packages_that_need_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 (':', 
-                            $ret{'different_packages'}->{$p}->{'revision'});
-          if ($rA >= $rB) {
-            $packages_that_need_fixup{$p} = 1;
-          }
-        }
+  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 {
-        # there have been no changed filelists, but we still check that
-        # revision is not going backward out of some strange other reason
-        if (defined($ret{'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 (':', 
-                            $ret{'different_packages'}->{$p}->{'revision'});
-          if ($rA > $rB) {
-            tlwarn("$progname: big warning for $p: file lists didn't change but "
-                   . "revision is going backward! Very strange!\n");
-            $packages_that_need_fixup{$p} = 1;
-          }
+        # 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("$progname: 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
+
+  # if requested, also may need to fix up packages with catalogue changs.
+  if ($opt_catalogue_compare) {
+    my %cat_fixup = tlpdb_catalogue_compare($oldtlpdb, $opt_catalogue_compare);
+    # hash slice to merge %cat_fixup into %packages_needing_fixup;
+    # all the values are 1, so that doesn't matter.
+    @packages_needing_fixup{ keys %cat_fixup } = values %cat_fixup;
   }
-   
-  my $commitit = 0;
 
+  my $do_commit = 0;
   my @svn_changed_files = ();
 
-  for my $p (keys %packages_that_need_fixup) {
-    tlwarn("$progname: package $p has different files but same/decreasing revision number\n");
+  for my $p (sort keys %packages_needing_fixup) {
+    tlwarn("$progname: package $p has different files but "
+           . "same/decreasing revision number",
+           $opt_fix_reverse_revisions ? "\n" 
+                         : " [skipping fix since no fix_reverse_revisions]\n");
     if ($opt_fix_reverse_revisions) {
       my $fixfile = "$opt_master/tlpkg/tlpsrc/$p.tlpsrc";
       # make sure that we actually fix a file of the right package
       if (! -r $fixfile) {
-        # we re quite probably trying to fix a .ARCH package with decreasing
+        # we might be trying to fix a .ARCH package with decreasing
         # revision number, but since we do NOT include the .tlpsrc file
         # in the computation of the .ARCH packages, we have to find a file
         # in the packages
@@ -269,35 +304,36 @@ sub compare_and_fix_tlpdbs {
       tlwarn("$progname: trying to fix it by running:\n");
       my $time = time();
       my $cmd = "svn propset texlive:force_incr_after_delete $time $fixfile";
-      $commitit = 1;
+      $do_commit = 1;
       tlwarn("  $cmd\n");
       TeXLive::TLUtils::xsystem($cmd);
       push @svn_changed_files, $fixfile;
     }
   }
+
   if ($opt_no_commit) {
-    if ($commitit) {
+    if ($do_commit) {
       tlwarn("$progname: tlpsrc files have been changed but not committed.\n");
       tlwarn("$progname: svn status output follows:\n");
       my $r = `svn status @svn_changed_files 2>&1`;
-      tlwarn($r . "\n");
+      tlwarn("$r\n");
     }
-    $commitit = 0;
+    $do_commit = 0;
   }
-  if ($commitit) {
+  if ($do_commit) {
     tlwarn("$progname: committing changes to tlpsrc files:\n");
     TeXLive::TLUtils::xsystem("svn commit "
       . "-m'($progname) force increased revision after removal of files' "
       . "@svn_changed_files");
   }
-  if (keys %packages_that_need_fixup) {
-    return 1;
-  } else {
-    return 0;
-  }
+  
+  return (keys %packages_needing_fixup >= 1);
 }
 
 
+# Return a TLPDB object based on $opt_master, using passed $TLC for the
+# Catalogue source and various $opt_... globals for all else.
+#
 sub create_tlpdb {
   my ($tlc) = @_;
   
@@ -355,7 +391,7 @@ sub create_tlpdb {
    
     # split bin packages off unless requested otherwise (no reason to so
     # request these days).
-    unless ($opt_nobinsplit) {
+    unless ($opt_no_binsplit) {
       # - split: texlive.infra but NO OTHER PACKAGE containing \.
       # - NO split: 00texlive
       # packages which have already a .SOMETHING extension or the 
@@ -373,8 +409,8 @@ sub create_tlpdb {
           # as this is actually wrong ..
           $binobj->recompute_revision ($tltree);
           if ($binobj->revision == 0) {
-            debug("Packages with revision number 0 are not added: " .
-                  $binobj->name . "\n");
+            ddebug("Package with revision number 0 not added: " .
+                   $binobj->name . "\n");
           } else {
             $tldb->add_tlpobj ($binobj);
           }
@@ -420,12 +456,11 @@ sub create_tlpdb {
   }
   $tldb->root ($opt_master);
 
-  #
   # we set several options in 00texlive.installation only in two cases:
   # 1) we are updating from *all* tlpsrc file, so no cmd line options
   # 2) we are updating from cmd line tlpsrc file, but 00texlive.installation
   #    is contained in the list
-
+  #
   if (!$opt_tlpsrc_from_cmdline || $found_texlive_installation) {
     # do set the option_archs from the dirs in Master/bin
     my @archs = $tltree->architectures;
@@ -440,6 +475,174 @@ sub create_tlpdb {
 
 
 
+# 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)
+# of packages that so differ.
+# 
+# We do not worry about packages found in one tlpdb and not the other;
+# those will get found in other places. Our goal here is just to compare
+# the Catalogue data in packages common to the two tlpdbs.
+# 
+# In practice, CMP_TLPDB is tlnet. This whole check is necessary because
+# we intentionally do not (normally) update packages in tlnet when only
+# Catalogue data has changed; that can easily lead to extra downloads
+# for a single real update of the package, since the metadata often
+# needs tweaking after an upload.
+# 
+# On the other hand, we do want to get current Catalogue data into TL
+# sometimes, or it would grow stale forever; so that's what this
+# comparison is for. We enable it once a month or so from cron.tl.
+# 
+# We do insert Catalogue updates into the texlive.tlpdb checked into the
+# repository (under Master/) nightly, but that is not what users
+# (typically) use.
+# 
+# This was not an issue before the switch to versioned containers in
+# November 2019 and the TL'20 release; before then, we recreated all
+# packages at every yearly release, so got all Catalogue updates at that
+# time. But nowadays we don't ever blindly recreate all packages.
+# 
+sub tlpdb_catalogue_compare {
+  my ($master_tlpdb,$cmp_tlpdb_str) = @_;
+  my %ret;
+  
+  my $cmp_tlpdb = TeXLive::TLPDB->new("root" => $cmp_tlpdb_str);
+  die "$progname: no tlpdb to compare under: $cmp_tlpdb_str\n"
+    if ! defined $cmp_tlpdb;  
+
+  for my $p ($master_tlpdb->list_packages()) {
+    my $tlpA = $master_tlpdb->get_package($p);
+    my $tlpB = $cmp_tlpdb->get_package($p);
+    
+    next unless defined $tlpA && defined $tlpB;
+    
+    # The Master tree isn't relocatable, but for the comparison (tlnet)
+    # tree, must swap RELOC marker for actual tree so we can compare.
+    $tlpB->replace_reloc_prefix();
+    
+    if (! &tlpobj_catalogue_equal($tlpA, $tlpB)) {
+      debug("$progname: Catalogue changes in package: $p\n");
+      $ret{$p} = 1;
+    }
+  }
+  debug("$progname: ", 0 + keys %ret, " packages with Catalogue changes\n");
+
+  return %ret;
+}
+
+# Return true if TLPOBJ arguments TLPA and TLPB have the same
+# Catalogue-related data. Includes short and long descriptions,
+# catalogue-* keys (cataloguedata), and tags of docfiles (docfiledata).
+# 
+sub tlpobj_catalogue_equal {
+  my ($tlpA,$tlpB) = @_;
+  my $ret = 0;
+  
+  my $pkg = $tlpA->name; # just for debugging output
+  ddebug("$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");
+    
+  } elsif (! &equal_strings($tlpA->longdesc, $tlpB->longdesc)) {
+    ddebug("$pkg: longdesc changed\n");
+
+  } elsif (! &equal_strings($tlpA->catalogue, $tlpB->catalogue)) {
+    ddebug("$pkg: catalogue value changed\n");
+
+  } elsif (! &equal_hashes($tlpA->cataloguedata, $tlpB->cataloguedata)) {
+    ddebug("$pkg: cataloguedata changed\n");
+
+  } elsif (! &equal_hashes($tlpA->docfiledata, $tlpB->docfiledata)) {
+    ddebug("$pkg: docfiledata changed\n");
+  
+  } else {
+    $ret = 1; # seems there were no Catalogue changes.
+  }
+  
+  return $ret;
+}
+
+
+
+# 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 {
+  my ($a,$b) = @_;
+  return (!defined $a && !defined $b)
+         || (defined $a && defined $b && $a eq $b);
+}
+
+
+# Return true if both H1 and H2 are references to hashes
+# with identical contents -- same keys, same values, recursively.
+# (Or are both undef.)
+# 
+# Only checks strings and hash references, not lists or other types.
+# 
+sub equal_hashes {
+  my ($h1,$h2) = @_;
+
+  # if neither is defined, that's ok.
+  return 1 if !defined $h1 && !defined $h2;
+  
+  # both must be hash references.
+  if (! (&is_hash_ref($h1) && is_hash_ref($h2))) {
+    ddebug(" 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. ",
+           join("|", keys %$h2), "\n");
+    return 0;
+  }
+  
+  # if they have no keys, they are the same (we won't go through the loop).
+  my $ret = (keys %$h1 == 0);
+  #
+  for my $k (keys %$h1) {
+    #debug(" checking key $k\n");
+    my $aval = $h1->{$k};
+    my $bval = $h2->{$k};
+    
+    if (!defined $aval && !defined $bval) {
+      # ok if both are undefined.
+      $ret = 1;
+    } else {
+      # else both have to be defined.
+      #debug("  for $k, aval=$aval, bval=$bval\n");
+      return 0 unless (defined $aval && defined $bval);
+    }
+
+    #debug(" comparing key $k: $aval vs. $bval\n");
+    if (&is_hash_ref($aval)) {
+      # if both are hashes compare, else must be not equal.
+      $ret = &is_hash_ref($bval) ? &equal_hashes($aval, $bval) : 0;
+    } else {
+      # we don't have arrays, non-strings, etc., so don't implement.
+      $ret = &equal_strings($aval, $bval);
+    }
+
+    last if $ret == 0;
+  }
+  
+  #debug ("equal_hashes returns: $ret\n");
+  return $ret;
+}
+
+# Return true if arg H is a reference to a hash.
+# 
+sub is_hash_ref {
+  my ($h) = @_;
+  return defined $h && ref $h && $h =~ /HASH/;
+}
+
+
 sub finish {
   my ($tlpdb,$pkgcount) = @_;
   if ($opt_output) {
@@ -455,7 +658,6 @@ sub finish {
   }
   exit (0);
 }
-
 __END__
 
 =head1 NAME
@@ -478,11 +680,19 @@ the generated tlpobj files will contain information gathered from the
 TeX Catalogue.  To disable this, specify a nonexistent filename, e.g.,
 C<--catalogue=/nonesuch>.
 
+=item B<--catalogue-compare> I<tlpdb>
+
+By default, packages for which the only change is in the Catalogue data
+are not marked as updated and written with new revisions. This option
+changes that. We enable this for major releases. This implies
+C<--reverse-revision-check>, since the same mechanism is used to force
+the new version numbers.
+
 =item B<--fix-reverse-revisions>
 
-If a package with revisions going backward is found, this option makes
-C<tl-update-tlpdb> try to check in a dummy change to the package's
-tlpsrc file to artificially increase its version number.
+If a package with revision number going backward is found, this option
+forces a dummy change (C<svn propset>) to the package's tlpsrc (or
+other) file to artificially increase its version number.
 
 =item B<--from-files>
 
@@ -495,20 +705,30 @@ Use C<find>, C<git>, and git-over-svn, respectively, instead of C<svn
 respective function in L<TeXLive::TLTree> to initialize the tree of
 files. By default, Subversion is used.
 
+With C<--from-files>, all the revision numbers will be 1.
+
+=item B<--keep-revisions>
+
+If B<--no-reverse-revision-check> is also specified, this option copies
+revision numbers from the existing tlpdb to the new one. Normally this
+dos not happen.
+
 =item B<--master> I<Master_dir>
 
-The location I<Master/dir> must point to a valid svn repository of TeX
-Live's Master directory.  Defaults to C<../..> of C<$0>.
+The I<Master/dir> directory must point to a valid repository of TeX
+Live's Master directory (Subversion by default; depends on the
+C<--from...> options given). Defaults to C<../..> of C<$0>.
 
 =item B<-n>, B<--dry-run>
 
 Don't make permanent changes: same as C<--no-commit> and
-C<--no-reverse-revision-check>, plus output to the C</tmp/tlut> (if no
-C<--output> file is given) rather than updating the current tlpdb.
+C<--no-fix-reverse-revisions>, plus C<--no-reverse-revision-check> (if
+not otherwise specified) plus output to C</tmp/tlut> (if no C<--output>
+file is given) rather than updating the current tlpdb.
 
 =item B<--no-bin-split>
 
-Do NOT split files with binaries into several packages (one for the arch
+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.
 
@@ -525,18 +745,19 @@ By default, C<tl-update-tlpdb> checks that in the generated tlpdb the
 revision numbers of packages are not going backward compared to the
 current tlpdb (see below). This option disables this check.
 
-=item B<--output=filename>
+=item B<--output> I<filename>
 
 By default, C<tl-update-tlpdb> saves/updates the tlpdb in the default
-place.  This option specifies the place where the output should go to.
+place, except that with C<-n>, the default is C</tmp/tlut>. This option
+specifies the place where the output should go to.
 
 =item B<--save-anyway>
 
-If the newly created tlpdb is in considered buggy due to reversed
-revisions it will normally not be saved. This switch allows saving it
+If the newly created tlpdb is considered buggy due to (unfixed) reversed
+revisions, it will normally not be saved. This switch allows saving it
 anyway. It can be useful in combination with the C<--from-files> option
-where the revision numbers will be adjusted afterwards by an external
-program.
+for testing, or if the revision numbers will be adjusted afterwards by
+an external program.
 
 =item B<--tlpsrc-from-cmdline>
 
@@ -548,7 +769,7 @@ option to use (along with C<-n> and C<--catalogue=/nonesuch>, most
 likely). Indeed, if any non-option arguments are given, the program
 assumes you meant to specify this option.
 
-=item B<--with-w32-pattern-warning>
+=item B<--w32-pattern-warning>
 
 Normally, this program issues a warning for patterns without a matching
 file, with the exception that it does I<not> warn for binpatterns
@@ -563,8 +784,9 @@ L<TeXLive::TLUtils> for details.
 
 =head1 DESCRIPTION
 
-C<tl-update-tlpdb> converts TeX Live source package files (tlpsrc) files
-into a TeX Live package database (tlpdb).
+C<tl-update-tlpdb> converts a TeX Live directory hierarchy, along with
+TeX Live source package files (tlpsrc) files, into a TeX Live package
+database (tlpdb).
 
 By default, it looks at Subversion output to determine the files in the
 current tree to place into the tlpdb. With the C<--from-files> option,
@@ -574,13 +796,22 @@ and C<--from-gitsvn>.
 In addition, if at the same location there is already a tlpdb, it
 compares the revision number of packages and checks if a package is
 going back in time (i.e., has a smaller revision number in the new
-tlpdb). This can happen when a file is removed and no other changes to
-the package made. In this case it commits a dummy change to the
-package's tlpsrc file to make sure that revisions are always increasing.
-The check is omitted if C<--no-reverse-revision-check> is specified.
-
-If a TeX Catalogue hierarchy is specified, additional information from
-the Catalogue is merged into the database (see L<TeXLive::TLPOBJ>).
+tlpdb). This can happen, for example, when a file is removed and no
+other changes to the package made. In this case it does an C<svn
+propset> on the package's tlpsrc (or other) file to ensure that
+revisions are always increasing. The check is omitted if
+C<--no-reverse-revision-check> is specified, and the property changes
+are not committed unless C<--fix-reverse-revisions> is given.
+
+If a TeX Catalogue hierarchy is available, additional information from
+the Catalogue is merged into the database (see L<TeXLive::TeXCatalogue>
+and L<TeXLive::TLPOBJ>).
+
+=head1 SEE ALSO
+
+The modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and
+the rest), and the other scripts in C<Master/tlpg/bin/> (especially
+C<tl-update-containers>), the documentation in C<Master/tlpkg/doc/>, etc.
 
 =head1 AUTHORS AND COPYRIGHT