From f7c1ee6c9d7fad1fe918ca68e23bf03b95008e1c Mon Sep 17 00:00:00 2001
From: Norbert Preining <preining@logic.at>
Date: Fri, 5 Mar 2010 16:08:00 +0000
Subject: tlmgr update changes: merge the update and new package install loops
 into one so that first all packages are updated, then new package installed,
 then collections updated, then new collections installed, then schemes
 updated, then new schemes installed. This should fix the problem when during
 the installation of a new package the connection breaks down the package is
 later on marked as forcibly removed.

git-svn-id: svn://tug.org/texlive/trunk@17333 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/texmf/scripts/texlive/tlmgr.pl | 395 ++++++++++++++++++----------------
 1 file changed, 207 insertions(+), 188 deletions(-)

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index a11cedc2740..f0daffa7810 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -2054,14 +2054,21 @@ sub action_update {
 
 
   # 
-  # UPDATES
+  # UPDATES AND NEW PACKAGES
   #
+  # order:
+  # - update normal packages
+  # - install new normal packages
+  # - update collections
+  # - install new collections
+  # - update schemes
+  # - install new schemes (? will not happen?)
   #
-  # update order of packages:
-  # first all normal packages, then collections, then schemes
-  # this way if installation breaks off and a new package in a collection
-  # isn't already installed, but the collection already updated, it will
-  # be reported as forcibly removed.
+  # this makes sure that only if all depending packages are installed
+  # the collection is updated, which in turn makes sure that 
+  # if the installation of a new package does break it will not be
+  # counted as forcibly removed later on.
+  # 
   my @inst_packs;
   my @inst_colls;
   my @inst_schemes;
@@ -2077,165 +2084,6 @@ sub action_update {
   }
   @inst_packs = sort packagecmp @inst_packs;
 
-  #
-  foreach my $pkg (@inst_packs, @inst_colls, @inst_schemes) {
-    # skip this loop if infra update on w32
-    next if ($pkg =~ m/^00texlive/);
-    my $tlp = $localtlpdb->get_package($pkg);
-    # we checked already that this package is present!
-    # but our checks seem to be wrong, no idea why
-    if (!defined($tlp)) {
-      tlwarn("tlmgr: tlp for package $pkg cannot be found, please report.\n");
-      next;
-    }
-    my $unwind_package;
-    my $remove_unwind_container = 0;
-    my $rev = $tlp->revision;
-    my $mediatlp = $tlmediatlpdb->get_package($pkg);
-    if (!defined($mediatlp)) {
-      debug("$pkg cannot be found in $location\n");
-      next;
-    }
-    my $mediarev = $mediatlp->revision;
-    $nrupdated++;
-    if ($opts{"list"}) {
-      if ($::machinereadable) {
-        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
-      } else {
-        my $kb = int($sizes{$pkg} / 1024) + 1;
-        info("$pkg [${kb}k]: local: $rev, source: $mediarev (update)\n");
-      }
-      $updated{$pkg} = 1;
-      next;
-    } elsif (win32() && ($pkg =~ m/$CriticalPackagesRegexp/)) {
-      # we pretend that the update happened
-      # in order to calculate file changes properly
-      $updated{$pkg} = 1;
-      next;
-    }
-
-    # older tlmgr forgot to clear the relocated bit when saving a tlpobj
-    # into the local tlpdb, although the paths were rewritten. 
-    # We have to clear this bit otherwise the make_container calls below
-    # for creating an unwind container will create some rubbish
-    # TODO for user mode we should NOT clear this bit!
-    if ($tlp->relocated) {
-      debug("tlmgr: warn, relocated bit set for $pkg, but that is wrong!\n");
-      $tlp->relocated(0);
-    }
-
-    if ($opts{"backup"} && !$opts{"dry-run"}) {
-      $tlp->make_container("xz", $root,
-                           $opts{"backupdir"}, "${pkg}.r" . $tlp->revision,
-                           $tlp->relocated);
-      $unwind_package =
-        "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.xz";
-
-      if ($autobackup) {
-        # in case we do auto backups we remove older backups
-        clear_old_backups($pkg, $opts{"backupdir"}, $autobackup);
-      }
-    }
-
-    my ($estrem, $esttot);
-    if (!$opts{"list"}) {
-      ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
-                             $donesize, $starttime);
-    }
-
-    if ($::machinereadable) {
-      machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot);
-    } else {
-      my $kb = int ($sizes{$pkg} / 1024) + 1;
-      info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarev)");
-    }
-    $donesize += $sizes{$pkg};
-    $currnr++;
-
-    if ($opts{"dry-run"}) {
-      info("\n") unless $::machinereadable;
-      $updated{$pkg} = 1;
-      next;
-    } else {
-      info(" ... ") unless $::machinereadable;  # more to come
-    }
-
-    if (!$unwind_package) {
-      # no backup was made, so let us create a temporary .tar file
-      # of the package
-      my $tlp = $localtlpdb->get_package($pkg);
-      my ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp,
-                                    "__BACKUP_${pkg}.r" . $tlp->revision,
-                                    $tlp->relocated);
-      if ($s <= 0) {
-        tlwarn("\n$0: Creation of backup container of $pkg failed.\n");
-        tlwarn("Continuing to update other packages, please retry...\n");
-        # we should try to update other packages at least
-        next;
-      }
-      $remove_unwind_container = 1;
-      $unwind_package = "$fullname";
-    }
-    # first remove the package, then reinstall it
-    # this way we get rid of useless files
-    # force the deinstallation since we will reinstall it
-    #
-    # the remove_package should also remove empty dirs in case
-    # a dir is changed into a file
-    if ($pkg =~ m/$CriticalPackagesRegexp/) {
-      debug("Not removing critical package $pkg\n");
-    } else {
-      $localtlmedia->remove_package($pkg);
-    }
-    if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
-      # installation succeeded because we got a reference
-      logpackage("update: $pkg ($rev -> $mediarev)");
-      unlink($unwind_package) if $remove_unwind_container;
-      # remember successful update
-      $updated{$pkg} = 1;
-    } else {
-      # install_package returned a scalar, so error.
-      # now in fact we should do some cleanup, removing files and
-      # dirs from the new package before re-installing the old one.
-      # TODO
-      logpackage("failed update: $pkg ($rev -> $mediarev)");
-      tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n");
-      if (win32()) {
-        # w32 is notorious for not releasing a file immediately
-        # we experienced permission denied errors
-        my $newname = $unwind_package;
-        $newname =~ s/__BACKUP/___BACKUP/;
-        copy ("-f", $unwind_package, $newname);
-        # try to remove the file if has been created by us
-        unlink($unwind_package) if $remove_unwind_container;
-        # and make sure that the temporary file is removed in any case
-        $remove_unwind_container = 1;
-        $unwind_package = $newname;
-      }
-      my $instret = TeXLive::TLMedia->_install_package("$unwind_package", 0,
-                                                       [], $localtlpdb);
-      if ($instret) {
-        # now we have to include the tlpobj
-        my $tlpobj = TeXLive::TLPOBJ->new;
-        $tlpobj->from_file($root . "/tlpkg/tlpobj/$pkg.tlpobj");
-        $localtlpdb->add_tlpobj($tlpobj);
-        $localtlpdb->save;
-        logpackage("restore: $pkg ($rev)");
-        tlwarn("Restoring old package state succeeded.\n");
-      } else {
-        logpackage("failed restore: $pkg ($rev)");
-        tlwarn("Restoring of old package did NOT succeed.\n");
-        tlwarn("Most likely repair: run tlmgr install $pkg and hope.\n");
-      }
-      unlink($unwind_package) if $remove_unwind_container;
-    }
-    info("done\n") unless $::machinereadable;
-  }
-
-
-  #
-  # NEW PACKAGES
-  #
   my @new_packs;
   my @new_colls;
   my @new_schemes;
@@ -2250,46 +2098,217 @@ sub action_update {
     }
   }
   @new_packs = sort packagecmp @new_packs;
+  my %is_new;
   for my $pkg (@new_packs, @new_colls, @new_schemes) {
-    if ($opts{"no-auto-install"}) {
-      info("not auto-installing $pkg due to -no-auto-install (new on server)\n")
-        unless $::machinereadable;
-    } else {
-      # install new packages
+    $is_new{$pkg} = 1;
+  }
+  
+  #
+  # TODO idea
+  # currently this big loop contains a long if then for new packages
+  # and updated package. That *could* be merged into one so that
+  # some things like the logging has not been written two times.
+  # OTOH, the control flow in the "new package" part is much simpler
+  # and following it after the change would make it much harder
+  #
+  foreach my $pkg (@inst_packs, @new_packs, @inst_colls, @new_colls, @inst_schemes, @new_schemes) {
+    
+    if (!$is_new{$pkg}) {
+      # skip this loop if infra update on w32
+      next if ($pkg =~ m/^00texlive/);
+      my $tlp = $localtlpdb->get_package($pkg);
+      # we checked already that this package is present!
+      # but our checks seem to be wrong, no idea why
+      if (!defined($tlp)) {
+        tlwarn("tlmgr: tlp for package $pkg cannot be found, please report.\n");
+        next;
+      }
+      my $unwind_package;
+      my $remove_unwind_container = 0;
+      my $rev = $tlp->revision;
       my $mediatlp = $tlmediatlpdb->get_package($pkg);
       if (!defined($mediatlp)) {
-        tlwarn("\nShould not happen: $pkg not found in $location");
+        debug("$pkg cannot be found in $location\n");
         next;
       }
       my $mediarev = $mediatlp->revision;
+      $nrupdated++;
+      if ($opts{"list"}) {
+        if ($::machinereadable) {
+          machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
+        } else {
+          my $kb = int($sizes{$pkg} / 1024) + 1;
+          info("$pkg [${kb}k]: local: $rev, source: $mediarev (update)\n");
+        }
+        $updated{$pkg} = 1;
+        next;
+      } elsif (win32() && ($pkg =~ m/$CriticalPackagesRegexp/)) {
+        # we pretend that the update happened
+        # in order to calculate file changes properly
+        $updated{$pkg} = 1;
+        next;
+      }
+      
+      # older tlmgr forgot to clear the relocated bit when saving a tlpobj
+      # into the local tlpdb, although the paths were rewritten. 
+      # We have to clear this bit otherwise the make_container calls below
+      # for creating an unwind container will create some rubbish
+      # TODO for user mode we should NOT clear this bit!
+      if ($tlp->relocated) {
+        debug("tlmgr: warn, relocated bit set for $pkg, but that is wrong!\n");
+        $tlp->relocated(0);
+      }
+
+      if ($opts{"backup"} && !$opts{"dry-run"}) {
+        $tlp->make_container("xz", $root,
+                             $opts{"backupdir"}, "${pkg}.r" . $tlp->revision,
+                             $tlp->relocated);
+        $unwind_package =
+            "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.xz";
+        
+        if ($autobackup) {
+          # in case we do auto backups we remove older backups
+          clear_old_backups($pkg, $opts{"backupdir"}, $autobackup);
+        }
+      }
+      
       my ($estrem, $esttot);
       if (!$opts{"list"}) {
         ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
-                               $donesize, $starttime);
+                                                             $donesize, $starttime);
       }
+      
       if ($::machinereadable) {
-        my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg});
-        if (!$opts{"list"}) {
-          push @maargs, $estrem, $esttot;
-        }
-        machine_line(@maargs);
+        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot);
       } else {
-        my $kb = int($sizes{$pkg} / 1024) + 1;
-        if ($opts{"list"}) {
-          info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n");
-        } else {
-          info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg [${kb}k]\n");
-        }
+        my $kb = int ($sizes{$pkg} / 1024) + 1;
+        info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarev)");
       }
-      $currnr++;
       $donesize += $sizes{$pkg};
-      next if ($opts{"dry-run"} || $opts{"list"});
+      $currnr++;
+      
+      if ($opts{"dry-run"}) {
+        info("\n") unless $::machinereadable;
+        $updated{$pkg} = 1;
+        next;
+      } else {
+        info(" ... ") unless $::machinereadable;  # more to come
+      }
+      
+      if (!$unwind_package) {
+        # no backup was made, so let us create a temporary .tar file
+        # of the package
+        my $tlp = $localtlpdb->get_package($pkg);
+        my ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp,
+                                      "__BACKUP_${pkg}.r" . $tlp->revision,
+                                      $tlp->relocated);
+        if ($s <= 0) {
+          tlwarn("\n$0: Creation of backup container of $pkg failed.\n");
+          tlwarn("Continuing to update other packages, please retry...\n");
+          # we should try to update other packages at least
+          next;
+        }
+        $remove_unwind_container = 1;
+        $unwind_package = "$fullname";
+      }
+      # first remove the package, then reinstall it
+      # this way we get rid of useless files
+      # force the deinstallation since we will reinstall it
+      #
+      # the remove_package should also remove empty dirs in case
+      # a dir is changed into a file
+      if ($pkg =~ m/$CriticalPackagesRegexp/) {
+        debug("Not removing critical package $pkg\n");
+      } else {
+        $localtlmedia->remove_package($pkg);
+      }
       if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
         # installation succeeded because we got a reference
-        logpackage("auto-install new: $pkg ($mediarev)");
-        $nrupdated++;
+        logpackage("update: $pkg ($rev -> $mediarev)");
+        unlink($unwind_package) if $remove_unwind_container;
+        # remember successful update
+        $updated{$pkg} = 1;
       } else {
-        tlwarn("$0: couldn't install new package $pkg\n");
+        # install_package returned a scalar, so error.
+        # now in fact we should do some cleanup, removing files and
+        # dirs from the new package before re-installing the old one.
+        # TODO
+        logpackage("failed update: $pkg ($rev -> $mediarev)");
+        tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n");
+        if (win32()) {
+          # w32 is notorious for not releasing a file immediately
+          # we experienced permission denied errors
+          my $newname = $unwind_package;
+          $newname =~ s/__BACKUP/___BACKUP/;
+          copy ("-f", $unwind_package, $newname);
+          # try to remove the file if has been created by us
+          unlink($unwind_package) if $remove_unwind_container;
+          # and make sure that the temporary file is removed in any case
+          $remove_unwind_container = 1;
+          $unwind_package = $newname;
+        }
+        my $instret = TeXLive::TLMedia->_install_package("$unwind_package", 0,
+                                                         [], $localtlpdb);
+        if ($instret) {
+          # now we have to include the tlpobj
+          my $tlpobj = TeXLive::TLPOBJ->new;
+          $tlpobj->from_file($root . "/tlpkg/tlpobj/$pkg.tlpobj");
+          $localtlpdb->add_tlpobj($tlpobj);
+          $localtlpdb->save;
+          logpackage("restore: $pkg ($rev)");
+          tlwarn("Restoring old package state succeeded.\n");
+        } else {
+          logpackage("failed restore: $pkg ($rev)");
+          tlwarn("Restoring of old package did NOT succeed.\n");
+          tlwarn("Most likely repair: run tlmgr install $pkg and hope.\n");
+        }
+        unlink($unwind_package) if $remove_unwind_container;
+      }
+      info("done\n") unless $::machinereadable;
+    } else { # $is_new{$pkg} is true!!!
+      # 
+      # NEW PACKAGES
+      #
+      if ($opts{"no-auto-install"}) {
+        info("not auto-installing $pkg due to -no-auto-install (new on server)\n")
+            unless $::machinereadable;
+      } else {
+        # install new packages
+        my $mediatlp = $tlmediatlpdb->get_package($pkg);
+        if (!defined($mediatlp)) {
+          tlwarn("\nShould not happen: $pkg not found in $location");
+          next;
+        }
+        my $mediarev = $mediatlp->revision;
+        my ($estrem, $esttot);
+        if (!$opts{"list"}) {
+          ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
+                                          $donesize, $starttime);
+        }
+        if ($::machinereadable) {
+          my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg});
+          if (!$opts{"list"}) {
+            push @maargs, $estrem, $esttot;
+          }
+          machine_line(@maargs);
+        } else {
+          my $kb = int($sizes{$pkg} / 1024) + 1;
+          if ($opts{"list"}) {
+            info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n");
+          } else {
+            info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg [${kb}k]\n");
+          }
+        }
+        $currnr++;
+        $donesize += $sizes{$pkg};
+        next if ($opts{"dry-run"} || $opts{"list"});
+        if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
+          # installation succeeded because we got a reference
+          logpackage("auto-install new: $pkg ($mediarev)");
+          $nrupdated++;
+        } else {
+          tlwarn("$0: couldn't install new package $pkg\n");
+        }
       }
     }
   }
-- 
cgit v1.2.3