updates for w32 updater logic by Tomek

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

1 files changed, 79 insertions, 100 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index f483509f8a3..d94ecf9950c 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -1118,133 +1118,111 @@ sub action_backup {
   return(\%ret);
 }
 
-
-$::updater_started = 0;
-
 #
 sub grow_w32_updater {
-  my ($tlp, $dry, $oldrev, $newrev) = @_;
-  my $pkg = $tlp->name;
-  # that could be more intelligent for decent $dry output
-  my $root = $localtlpdb->root;
-  my $temp = "$root/temp";
-  return if $dry;
-  if (!$::updater_started) {
-    $::updater_started = 1;
-    $::updater_string = <<'EOF';
-@echo off
-rem Update script for TeX-Live infrastructure
-rem called automatically after creation by tlmgr.bat wrapper
-rem left only for inspection, can be safely removed
-
-setlocal
-cd /d %~dp0
-rem now we are in .../tlpkg/installer
-rem create tar.exe backup
->nul copy tar.exe tarsave.exe 
-cd ..\..
-rem now we are in the root
-rem get location of the log file
-for /f "delims=" %%D in ('kpsewhich -var-value=TEXMFSYSVAR') do set "web2c=%%~fD\web2c\"
-rem set up perl environment
-set PERL5LIB=%cd%\tlpkg\tlperl\lib
-
-echo Performing an update of TeX-Live infrastructure
-echo In case of a disaster download and run:
-echo http://mirror.ctan.org/systems/texlive/tlnet/2008/update-tlmgr-latest.exe
-echo Do not close this window
-EOF
-;
-  }
-  sub do_one {# moved down to 'preserve' the flow of the batch script upon reading
-    my ($pkg, $oldrev, $newrev) = @_;
-    $::updater_string .= "
-tlpkg\\installer\\lzma\\lzmadec.win32.exe  < temp\\$pkg.tar.lzma > temp\\$pkg.tar
-tlpkg\\installer\\tarsave.exe -x -f temp\\$pkg.tar
-tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj tlpkg\\tlpobj\\$pkg.tlpobj
-echo update: $pkg ($oldrev -^> $newrev)
->>%web2c%tlmgr.log echo [%date% %time%] update: $pkg ($oldrev -^> $newrev)
-del temp\\$pkg.tar.lzma temp\\$pkg.tar
-";
-  }
+  my ($pkg, $opt_dry) = @_;
+  my $updater_string = '';
   # these packages cannot be upgrade on w32
   # so we have to create a update program
   my $media = $tlmediasrc->media;
   my $mediatlpdb = $tlmediasrc->tlpdb;
-  my $remoteroot = $mediatlpdb->root;
-  #
+  my $mediatlp = $mediatlpdb->get_package($pkg);
   # we have to download/copy also the src/doc files if necessary!
   my $container_src_split = $mediatlpdb->config_src_container;
   my $container_doc_split = $mediatlpdb->config_doc_container;
   # get options about src/doc splitting from $totlpdb
   my $opt_src = $localtlpdb->option_install_srcfiles;
-  my $opt_doc = $localtlpdb->option_install_docfiles;
-  my $real_opt_doc = $opt_doc;
-  if ($tlp->category =~ m/documentation/i) {
-    # we do install documenation files for category Documentation
-    # even if opt_doc is false
-    $real_opt_doc = 1;
-  }
-  my $do_src = 0;
-  my $do_doc = 0;
-  $do_src = 1 if ($container_src_split && $opt_src && $tlp->srcfiles);
-  $do_doc = 1 if ($container_doc_split && $real_opt_doc && $tlp->docfiles);
+  # we do install documenation files for category Documentation even if option_install_docfiles is false
+  my $opt_doc = ($mediatlp->category =~ m/documentation/i) ? 1 : $localtlpdb->option_install_docfiles;
+  my $do_src = ($container_src_split && $opt_src && $mediatlp->srcfiles) ? 1 : 0;
+  my $do_doc = ($container_doc_split && $opt_doc && $mediatlp->docfiles) ? 1 : 0;
+  my $temp = $localtlpdb->root . "/temp";
   TeXLive::TLUtils::mkdirhier($temp);
   if ($media eq 'DVD') {
     tlwarn ("Creating updater from DVD currently not implemented!\n");
     tlwarn ("But it should not be necessary!\n");
   } else {
-    if ($media eq 'CD') {
-      copy("$remoteroot/$Archive/$pkg.tar.lzma", "$temp");
-      copy("$remoteroot/$Archive/$pkg.doc.tar.lzma", "$temp") if $do_doc;
-      copy("$remoteroot/$Archive/$pkg.src.tar.lzma", "$temp") if $do_src;
+    my $oldrev = $localtlpdb->get_package($pkg)->revision;
+    my $newrev = $mediatlp->revision;
+    my $repo = $mediatlpdb->root . '/'. $Archive;
+    my @do_one_args = ($oldrev, $newrev, $repo, $temp, $opt_dry);
+    $updater_string .= do_one_pkg($pkg, @do_one_args);
+    $updater_string .= do_one_pkg("$pkg.src", @do_one_args) if ($do_src);
+    $updater_string .= do_one_pkg("$pkg.doc", @do_one_args) if ($do_doc);
+  }
+  return $updater_string;
+  sub do_one_pkg {
+    my ($pkg, $oldrev, $newrev, $repo, $temp, $opt_dry) = @_;
+    my $updater_string = '';
+    my $update_info = "update: $pkg ($oldrev -^> $newrev)";
+    if ($opt_dry) {
+      $update_info =~ s/\^//; # get rid of the batch escape char
+      info("$update_info\n");
+    } elsif ($tlmediasrc->media eq 'CD') {
+      copy("$repo/$pkg.tar.lzma", "$temp");
     } else { # net
-      TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.tar.lzma", "$temp/$pkg.tar.lzma");
-      TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.doc.tar.lzma", "$temp/$pkg.doc.tar.lzma") if $do_doc;
-      TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.src.tar.lzma", "$temp/$pkg.src.tar.lzma") if $do_src;
+      TeXLive::TLUtils::download_file("$repo/$pkg.tar.lzma", "$temp/$pkg.tar.lzma");
     }
     # now we should have the file present
-    if (! -r "$temp/$pkg.tar.lzma") {
+    if (!$opt_dry && ! -r "$temp/$pkg.tar.lzma") {
       tlwarn ("Couldn't get $pkg.tar.lzma, that is bad\n");
     } else {
-      # add lines to the un-archiver
-      do_one ($pkg, $oldrev, $newrev);
-    }
-    if ($do_src) {
-      if (! -r "$temp/$pkg.src.tar.lzma") {
-        tlwarn ("Couldn't get $pkg.src.tar.lzma, that is bad\n");
-      } else {
-        # add lines to the un-archiver
-        do_one ("$pkg.src", $oldrev, $newrev);
-      }
-    }
-    if ($do_doc) {
-      if (! -r "$temp/$pkg.doc.tar.lzma") {
-        tlwarn ("Couldn't get $pkg.doc.tar.lzma, that is bad\n");
-      } else {
-        # add lines to the un-archiver
-        do_one ("$pkg.doc", $oldrev, $newrev);
-      }
+      # add lines to the updater script string
+      $updater_string = "
+tlpkg\\installer\\lzma\\lzmadec.win32.exe  < temp\\$pkg.tar.lzma > temp\\$pkg.tar
+tlpkg\\installer\\tarsave.exe -x -f temp\\$pkg.tar
+tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj tlpkg\\tlpobj\\$pkg.tlpobj
+echo $update_info
+>>%logdir%tlmgr.log echo [%date% %time%] $update_info
+del temp\\$pkg.tar.lzma temp\\$pkg.tar
+";
     }
+    return $updater_string;
   }
 }
 
 sub write_w32_updater {
-  if ($::updater_started) {
-    $::updater_string .= <<'EOF';
+  #TODO: think of some way to validate the update
+  my $updater_string = shift;
+  # assemble the updater script string
+  $updater_string = <<'EOF'
+@echo off
+rem Update script for TeX Live infrastructure
+rem called automatically after creation by tlmgr.bat wrapper
+rem left only for inspection, can be safely removed
+
+setlocal
+cd /d %~dp0
+rem now we are in .../tlpkg/installer
+rem create tar.exe backup
+>nul copy tar.exe tarsave.exe 
+cd ..\..
+rem now we are in the root
+rem get location of the log file
+for /f "delims=" %%D in ('kpsewhich -var-value=TEXMFSYSVAR') do set "logdir=%%~fD\web2c\"
+rem set up perl environment
+set PERL5LIB=%cd%\tlpkg\tlperl\lib
+
+echo Do not close this window! TeX Live infrastructure update in progress...
+echo In case of a disaster download and run:
+echo http://mirror.ctan.org/systems/texlive/tlnet/2008/update-tlmgr-latest.exe
+EOF
+
+. $updater_string . <<'EOF'
 
 del tlpkg\installer\tarsave.exe
-rem rmdir temp
+rem Before we can enable self-delete, we need to validate the update somehow. 
+rem start /b cmd /c del "%%~f0"
 EOF
 ;
-    open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater.bat"
-      or die "Cannot create updater.bat: $!";
-    # print STDOUT $::updater_string;
-    print UPDATER $::updater_string;
-    close UPDATER;
-    tlwarn("UPDATER script has been created:\n");
-    tlwarn("   " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n");
-  }
+  # write the updater script to file
+  open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater.bat"
+    or die "Cannot create updater.bat: $!";
+  print UPDATER $updater_string;
+  close UPDATER;
+  # tlwarn("UPDATER script has been created:\n");
+  # tlwarn("   " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n");
+  # print STDOUT $updater_string;
 }
 
 
@@ -1623,6 +1601,7 @@ sub action_update {
   }
 
   #
+  my $w32_updater = '' if win32();
   foreach my $pkg (sort @updated) {
     next if ($pkg =~ m/^00texlive/);
     my $tlp = $localtlpdb->get_package($pkg);
@@ -1657,7 +1636,7 @@ sub action_update {
       }
 
       if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
-        grow_w32_updater($mediatlp, $opts{"dry-run"}, $rev, $mediarev);
+        $w32_updater .= grow_w32_updater($pkg, $opts{"dry-run"});
       } else {
         if ($::machinereadable) {
           machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
@@ -1742,7 +1721,7 @@ sub action_update {
   }
 
   # that already checks whether we actually have to do something
-  write_w32_updater();
+  write_w32_updater($w32_updater) if (win32() && $w32_updater && !$opts{"dry-run"});
   if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opts{"all"}) {
     # for all but net updates we warn if nothing is updated
     tlwarn("\nNothing to update.\n");
@@ -2495,8 +2474,8 @@ sub init_tlmedia {
 
     # $tlmediasrc is a global variable
     $tlmediasrc = TeXLive::TLMedia->new($location);
-    $tlmediatlpdb = $tlmediasrc->tlpdb;
     die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+    $tlmediatlpdb = $tlmediasrc->tlpdb;
   }
 }