texlive[67104] Master/tlpkg/bin/tl-update-containers: try to

[commits+karl at tug.org]

Revision: 67104
          http://tug.org/svn/texlive?view=revision&revision=67104
Author:   karl
Date:     2023-05-14 03:17:45 +0200 (Sun, 14 May 2023)
Log Message:
-----------
try to consistently report names of the new/removed/updated packages.

Modified Paths:
--------------
    trunk/Master/tlpkg/bin/tl-update-containers

Modified: trunk/Master/tlpkg/bin/tl-update-containers
===================================================================
--- trunk/Master/tlpkg/bin/tl-update-containers	2023-05-13 23:42:54 UTC (rev 67103)
+++ trunk/Master/tlpkg/bin/tl-update-containers	2023-05-14 01:17:45 UTC (rev 67104)
@@ -1,6 +1,6 @@
 #!/usr/bin/env perl
 # $Id$
-# Copyright 2008-2020 Norbert Preining
+# Copyright 2008-2023 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 # 
@@ -114,6 +114,12 @@
     info("$prg: additional tlnet disabled packages: @disabled_pkgs\n");
   }
 
+  # collect package status lists.
+  my (@pkgs_new);
+  my (@pkgs_updated);
+  my (@pkgs_removed);
+  my $count_unchanged = 0;
+
   if ($opt_recreate) {
     # remake everything.
     if (@ARGV) {
@@ -139,10 +145,6 @@
       }
     }
 
-    # collect packages to be updated.
-    $count{"new"} = $count{"removed"} = $count{"updated"} = $count{"unchanged"}
-                  = 0;
- 
     for my $pkg (@packs) {
       # by definition, any 00texlive... package does not need containers.
       next if $pkg =~ /00texlive/;
@@ -164,8 +166,7 @@
           && defined($archiverevs{$pkg})) {
         $oldrev = $archiverevs{$pkg};
       } else {
-        info("$prg: $pkg is new\n");
-        $count{"new"}++;
+        push (@pkgs_new, $pkg);
       }
 
       my $tlp = $tlpdb->get_package($pkg);
@@ -187,13 +188,13 @@
                 && ! -r "$opt_containerdir/$pkg.doc.tar.$type")) {
           info("$prg: container(s) for $pkg disappeared, recreating them.\n");
           push @todopacks, $pkg;
-          $count{"updated"}++;
+          push (@pkgs_updated, $pkg);
         } else {
-          $count{"unchanged"}++;
+          $count_unchanged++;
         }
       } elsif ($oldrev < $newrev) {
         push @todopacks, $pkg;
-        $count{"updated"}++ if $oldrev;
+        push (@pkgs_updated, $pkg) if $oldrev;
       } else {
         # This can happen when packages get renamed or files get
         # shuffled from one package to another.
@@ -261,7 +262,7 @@
           tlwarn("$prg: Skipping critical $pkg\n");
           # we assume that the critical packages always exist, so reduce
           # the number of updated packages.
-          $count{'updated'}--;
+          @pkgs_updated = &remove_from_list (\@pkgs_updated, $pkg);
           
           # the following line skips all other regexp checks on critical
           # packages and skips everything below this (the part which
@@ -409,7 +410,7 @@
     info("$prg: $op has disappeared, removing its containers\n");
     `rm $opt_containerdir/$op.*` unless $opt_dry;
     $nettlpdb->remove_package($op) unless $opt_dry;
-    $count{"removed"}++;
+    push (@pkgs_removed, $op);
   }
 
   # remove non-symlinked .rNNN files.
@@ -419,9 +420,14 @@
     info("$prg: all packages recreated.\n");
   } else {
     if (@todopacks) {
-      # we updated something
-      info("$prg: $count{new} new, $count{removed} removed, " .
-            "$count{updated} updated, $count{unchanged} unchanged.\n");
+      # something changed.
+      for my $listname (qw(new removed updated)) {
+        my @list = eval ('@new_' . $listname);
+        info("$prg: ", 0 + @list, " $listname");
+        info(@list ? ": @list" : ".");
+        info("\n");
+      }
+      info("$prg: $count_unchanged unchanged.\n");
     } else {
       info("$prg: no containers to be updated.\n");
     }
@@ -511,6 +517,22 @@
   closedir ($dh) || warn "closedir($dir) failed: $!";
 }
 
+

+# This crummy little function returns a new list, a copy of @$LISTREF
+# except any elements eq to $ELT_TO_RM are removed. Plenty of smarter
+# and more general ways to do this, but this is just for reporting.
+# 
+sub remove_from_list {
+  my ($listref,$elt_to_rm);
+  my @ret = ();
+  
+  for my $elt (@$listref) {
+    push (@ret, $elt) unless $elt eq $elt_to_rm;
+  }
+  
+  return @ret;
+}
+
 __END__
 

 =head1 NAME