From 68de942a3e3ab2d927389d502695e37a898d6ad0 Mon Sep 17 00:00:00 2001
From: Norbert Preining <preining@logic.at>
Date: Mon, 11 Jun 2018 06:39:10 +0000
Subject: code cleanup and streamlining (use %Compressors)

git-svn-id: svn://tug.org/texlive/trunk@47985 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/texmf-dist/scripts/texlive/tlmgr.pl | 57 +++++++++++++++++-------------
 1 file changed, 32 insertions(+), 25 deletions(-)

(limited to 'Master/texmf-dist/scripts')

diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index 43be9babcae..02fe6c016fc 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -1759,19 +1759,23 @@ sub get_available_backups {
   my $oldwsloppy = ${^WIN32_SLOPPY_STAT};
   ${^WIN32_SLOPPY_STAT} = 1;
   #
+  my $pkg;
+  my $rev;
+  my $ext;
   for my $dirent (@dirents) {
+    $pkg = "";
+    $rev = "";
+    $ext = "";
     next if (-d $dirent);
-    my $has_accepted_compressiontype = 0;
-    for my $comptype (@AcceptedCompressors) {
-      my $ext = $CompressorExtension{$comptype};
-      $has_accepted_compressiontype = 1 if ($dirent =~ m/\.tar\.$ext$/);
-    }
-    next if (!$has_accepted_compressiontype);
-    if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.(.*)$/) {
+    if ($dirent =~ m/^(.*)\.r([0-9]+)\.tar\.$CompressorExtRegexp$/) {
+      $pkg = $1;
+      $rev = $2;
+      $ext = $3;
+    } else {
       next;
     }
     if (!$do_stat) {
-      $backups{$1}->{$2} = 1;
+      $backups{$pkg}->{$rev} = 1;
       next;
     }
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
@@ -1790,9 +1794,9 @@ sub get_available_backups {
     if (!$usedt) {
       # stat failed, set key to -1 as a sign that there is a backup
       # but we cannot stat it
-      $backups{$1}->{$2} = -1;
+      $backups{$pkg}->{$rev} = -1;
     } else {
-      $backups{$1}->{$2} = $usedt;
+      $backups{$pkg}->{$rev} = $usedt;
     }
   }
   # reset the original value of the w32 sloppy mode for stating files
@@ -1805,9 +1809,13 @@ sub restore_one_package {
   # first remove the package, then reinstall it
   # this way we get rid of useless files
   my $restore_file;
-  for my $comptype (@AcceptedCompressors) {
-    my $ext = $CompressorExtension{$comptype};
-    $restore_file = "$bd/${pkg}.r${rev}.tar.$ext" if (-r "$bd/${pkg}.r${rev}.tar.$ext");
+  for my $ext (map {$Compressors{$_}{'extension'}} 
+                 sort {$Compressors{$a}{'priority'} <=> $Compressors{$a}{'priority'}} 
+                   keys %Compressors) {
+    if (-r "$bd/${pkg}.r${rev}.tar.$ext") {
+      $restore_file = "$bd/${pkg}.r${rev}.tar.$ext";
+      last;
+    }
   }
   if (!$restore_file) {
     tlwarn("$prg: Cannot find restore file $bd/${pkg}.r${rev}.tar.*, no action taken\n");
@@ -2141,7 +2149,7 @@ sub action_backup {
       clear_old_backups ($pkg, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"}, 1);
     } else {
       # for now default to xz and allow overriding with env var
-      my $compressorextension = $CompressorExtension{$::progs{'compressor'}};
+      my $compressorextension = $Compressors{$::progs{'compressor'}}{'extension'};
       my $tlp = $localtlpdb->get_package($pkg);
       info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" .
         $tlp->revision . ".tar.$compressorextension\n");
@@ -2268,28 +2276,28 @@ sub write_w32_updater {
       tlwarn("$prg: Creation of backup container of $pkg failed.\n");
       return 1; # backup failed? abort
     }
-    my $decompressor = $::progs{$DecompressorProgram{$DefaultCompressorFormat}};
-    my $compressorextension = $CompressorExtension{$DefaultCompressorFormat};
-    my @decompressorArgs = @{$DecompressorArgs{$DefaultCompressorFormat}};
+    my $decompressor = $::progs{$DefaultCompressorFormat};
+    my $compressorextension = $Compressors{$DefaultCompressorFormat}{'extension'};
+    my @decompressorArgs = @{$Compressors{$DefaultCompressorFormat}{'decompress_args'}};
     foreach my $pkg_part (@pkg_parts) {
+      my $dlcontainer = "$temp/$pkg_part.tar.$compressorextension";
       if ($media eq 'local_compressed') {
         copy("$repo/$pkg_part.tar.$compressorextension", "$temp");
       } else { # net
-        TeXLive::TLUtils::download_file("$repo/$pkg_part.tar.$compressorextension", 
-                                        "$temp/$pkg_part.tar.$compressorextension");
+        TeXLive::TLUtils::download_file("$repo/$pkg_part.tar.$compressorextension", $dlcontainer);
       }
       # now we should have the file present
-      if (!-r "$temp/$pkg_part.tar.$compressorextension") {
+      if (!-r $dlcontainer) {
         tlwarn("$prg: Couldn't get $pkg_part.tar.$compressorextension, that is bad\n");
         return 1; # abort
       }
       # unpack xz archive
-      my $sysret = system("$decompressor @decompressorArgs < \"$temp/$pkg_part.tar.xz\" > \"$temp/$pkg_part.tar\"");
+      my $sysret = system("$decompressor @decompressorArgs < \"$dlcontainer\" > \"$temp/$pkg_part.tar\"");
       if ($sysret) {
         tlwarn("$prg: Couldn't unpack $pkg_part.tar.$compressorextension\n");
         return 1; # unpack failed? abort
       }
-      unlink("$temp/$pkg_part.tar.$compressorextension"); # we don't need that archive anymore
+      unlink($dlcontainer); # we don't need that archive anymore
     }
   }
   
@@ -3181,7 +3189,7 @@ sub action_update {
       }
 
       if ($opts{"backup"} && !$opts{"dry-run"}) {
-        my $compressorextension = $CompressorExtension{$::progs{'compressor'}};
+        my $compressorextension = $Compressors{$::progs{'compressor'}}{'extension'};
         $tlp->make_container($::progs{'compressor'}, $root,
                              $opts{"backupdir"}, "${pkg}.r" . $tlp->revision,
                              $tlp->relocated);
@@ -7261,10 +7269,9 @@ sub clear_old_backups {
   my @dirents = readdir (DIR);
   closedir (DIR) || warn "closedir($backupdir) failed: $!";
   my @backups;
-  my $extre = "(" . join("|", map { $CompressorExtension{$_} } @AcceptedCompressors) . ")";
   for my $dirent (@dirents) {
     next if (-d $dirent);
-    next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.$extre$/);
+    next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.$CompressorExtRegexp$/);
     push @backups, [ $1, $dirent ] ;
   }
   my $i = 1;
-- 
cgit v1.2.3