texlive[47985] Master: code cleanup and streamlining (use

commits+preining at tug.org commits+preining at tug.org
Mon Jun 11 08:39:11 CEST 2018


Revision: 47985
          http://tug.org/svn/texlive?view=revision&revision=47985
Author:   preining
Date:     2018-06-11 08:39:10 +0200 (Mon, 11 Jun 2018)
Log Message:
-----------
code cleanup and streamlining (use %Compressors)

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
    trunk/Master/tlpkg/TeXLive/TLConfig.pm
    trunk/Master/tlpkg/TeXLive/TLPDB.pm
    trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2018-06-11 06:32:20 UTC (rev 47984)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2018-06-11 06:39:10 UTC (rev 47985)
@@ -1759,19 +1759,23 @@
   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 @@
     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 @@
   # 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 @@
       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 @@
       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 @@
       }
 
       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 @@
   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;

Modified: trunk/Master/tlpkg/TeXLive/TLConfig.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLConfig.pm	2018-06-11 06:32:20 UTC (rev 47984)
+++ trunk/Master/tlpkg/TeXLive/TLConfig.pm	2018-06-11 06:39:10 UTC (rev 47985)
@@ -27,14 +27,8 @@
     %FallbackDownloaderProgram
     %FallbackDownloaderArgs
     $DefaultCompressorFormat
-    $DefaultContainerExtension
-    @AcceptedCompressors
-    $AcceptedCompressorsRegexp
-    %CompressorProgram
-    %DecompressorProgram
-    %CompressorArgs
-    %DecompressorArgs
-    %CompressorExtension
+    $CompressorExtRegexp
+    %Compressors
     $InfraLocation
     $DatabaseName
     $PackageBackupDir 
@@ -129,15 +123,29 @@
 );
 # the way we package things on the web
 our $DefaultCompressorFormat = "xz";
-our $DefaultContainerExtension = "tar.$DefaultCompressorFormat";
-# mind that the order here is important as gives also the preference!
-our @AcceptedCompressors = qw/lz4 gzip xz/;
-our $AcceptedCompressorsRegexp = "(xz|lz4|gzip)";
-our %CompressorProgram   = ( 'xz' => 'xz',     'gzip' => 'gzip',   'lz4' => 'lz4');
-our %CompressorExtension = ( 'xz' => 'xz',     'gzip' => 'gz',     'lz4' => 'lz4');
-our %CompressorArgs      = ( 'xz' => ['-zf'],  'gzip' => [ '-f' ], 'lz4' => ['-zfm', '--rm', '-q']);
-our %DecompressorProgram = ( 'xz' => 'xz',     'gzip' => 'gzip',   'lz4' => 'lz4');
-our %DecompressorArgs    = ( 'xz' => ['-dcf'], 'gzip' => ['-dcf'], 'lz4' => ['-dcf']);
+# priority defines which compressor is selected for backups/rollback containers
+# less is better
+our %Compressors = (
+  "lz4" => {
+    "decompress_args" => ["-dcf"],
+    "compress_args"   => ["-zfmq", "--rm"],
+    "extension"       => "lz4",
+    "priority"        => 10,
+  },
+  "gzip" => {
+    "decompress_args" => ["-dcf"],
+    "compress_args"   => ["-f"],
+    "extension"       => "gz",
+    "priority"        => 20,
+  },
+  "xz" => {
+    "decompress_args" => ["-dcf"],
+    "compress_args"   => ["-zf"],
+    "extension"       => "xz",
+    "priority"        => 30,
+  },
+);
+our $CompressorExtRegexp = "(" . join("|", map { $Compressors{$_}{'extension'} } keys(%Compressors)) . ")";
 
 # archive (not user) settings.
 # these can be overridden by putting them into 00texlive.config.tlpsrc

Modified: trunk/Master/tlpkg/TeXLive/TLPDB.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-06-11 06:32:20 UTC (rev 47984)
+++ trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-06-11 06:39:10 UTC (rev 47985)
@@ -91,9 +91,7 @@
 
 use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
       $DatabaseName $MetaCategoriesRegexp $Archive
-      $DefaultCompressorFormat $DefaultContainerExtension 
-      @AcceptedCompressors $AcceptedCompressorsRegexp %CompressorProgram
-      %CompressorExtension %CompressorArgs %DecompressorProgram %DecompressorArgs
+      $DefaultCompressorFormat %Compressors $CompressorExtRegexp
       %TLPDBOptions %TLPDBSettings $ChecksumExtension
       $RelocPrefix $RelocTree);
 use TeXLive::TLCrypto;
@@ -319,13 +317,13 @@
     # if we have xz available we try the xz file
     my $xz_succeeded = 0 ;
     my $compressorextension = "<UNSET>";
-    if (defined($::progs{$DecompressorProgram{$DefaultCompressorFormat}})) {
+    if (defined($::progs{$DefaultCompressorFormat})) {
       # we first try the xz compressed file
       my ($xzfh, $xzfile) = TeXLive::TLUtils::tl_tmpfile();
       close($xzfh);
-      my $decompressor = $::progs{$DecompressorProgram{$DefaultCompressorFormat}};
-      $compressorextension = $CompressorExtension{$DefaultCompressorFormat};
-      my @decompressorArgs = @{$DecompressorArgs{$DefaultCompressorFormat}};
+      my $decompressor = $::progs{$DefaultCompressorFormat};
+      $compressorextension = $Compressors{$DefaultCompressorFormat}{'extension'};
+      my @decompressorArgs = @{$Compressors{$DefaultCompressorFormat}{'decompress_args'}};
       debug("trying to download $path.$compressorextension to $xzfile\n");
       my $ret = TeXLive::TLUtils::download_file("$path.$compressorextension", "$xzfile");
       # better to check both, the return value AND the existence of the file
@@ -1810,17 +1808,17 @@
     if ($media eq 'local_uncompressed') {
       $container = \@installfiles;
     } elsif ($media eq 'local_compressed') {
-      for my $ext (@AcceptedCompressors) {
+      for my $ext (map { $Compressors{$_}{'extension'} } keys %Compressors) {
         if (-r "$root/$Archive/$pkg.tar.$ext") {
           $container = "$root/$Archive/$pkg.tar.$ext";
         }
       }
       if (!$container) {
-        tlwarn("TLPDB: cannot find package $pkg.tar.$AcceptedCompressorsRegexp in $root/$Archive\n");
+        tlwarn("TLPDB: cannot find package $pkg.tar.$CompressorExtRegexp in $root/$Archive\n");
         return(0);
       }
     } elsif (&media eq 'NET') {
-      $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
+      $container = "$root/$Archive/$pkg.tar." . $Compressors{$DefaultCompressorFormat}{'extension'};
     }
     debug("TLPDB::not_virtual_install_package: trying to install $container\n");
     $self->_install_data ($container, $reloc, \@installfiles, $totlpdb, $tlpobj->containersize, $tlpobj->containerchecksum)
@@ -1841,13 +1839,13 @@
       # - there are actually src/doc files present
       if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
         my $srccontainer = $container;
-        $srccontainer =~ s/\.tar\.$AcceptedCompressorsRegexp$/.source.tar.$1/;
+        $srccontainer =~ s/\.tar\.$CompressorExtRegexp$/.source.tar.$1/;
         $self->_install_data ($srccontainer, $reloc, \@installfiles, $totlpdb, $tlpobj->srccontainersize, $tlpobj->srccontainerchecksum)
           || return(0);
       }
       if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
         my $doccontainer = $container;
-        $doccontainer =~ s/\.tar\.$AcceptedCompressorsRegexp$/.doc.tar.$1/;
+        $doccontainer =~ s/\.tar\.$CompressorExtRegexp$/.doc.tar.$1/;
         $self->_install_data ($doccontainer, $reloc, \@installfiles, $totlpdb, $tlpobj->doccontainersize, $tlpobj->doccontainerchecksum)
           || return(0);
       }
@@ -1967,7 +1965,7 @@
     }
     # we always assume that copy will work
     return(1);
-  } elsif ($what =~ m,\.tar\.$AcceptedCompressorsRegexp$,) {
+  } elsif ($what =~ m,\.tar\.$CompressorExtRegexp$,) {
     if ($reloc) {
       if (!$totlpdb->setting("usertree")) {
         $target .= "/$RelocTree";

Modified: trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2018-06-11 06:32:20 UTC (rev 47984)
+++ trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2018-06-11 06:39:10 UTC (rev 47985)
@@ -12,9 +12,7 @@
 
 use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp 
                          $MetaCategoriesRegexp $InfraLocation 
-                         @AcceptedCompressors %CompressorArgs
-                         %CompressorProgram %CompressorExtension
-                         $DefaultCompressorFormat
+                         %Compressors $DefaultCompressorFormat
                          $RelocPrefix $RelocTree);
 use TeXLive::TLCrypto;
 use TeXLive::TLTREE;
@@ -718,14 +716,14 @@
 
   if ($type ne 'tar') {
     # compress it
-    my $compressor = $::progs{$CompressorProgram{$type}};
+    my $compressor = $::progs{$type};
     if (!defined($compressor)) {
       # fall back to $type as compressor, but that shouldn't happen
       tlwarn("$0: programs not set up, trying \"$type\".\n");
       $compressor = $type;
     }
-    my @compressorargs = @{$CompressorArgs{$type}};
-    my $compressorextension = $CompressorExtension{$type};
+    my @compressorargs = @{$Compressors{$type}{'compress_args'}};
+    my $compressorextension = $Compressors{$type}{'extension'};
     $containername = "$tarname.$compressorextension";
     debug("selected compressor: $compressor with @compressorargs, "
           . "on $destdir/$tarname\n");

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-06-11 06:32:20 UTC (rev 47984)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-06-11 06:39:10 UTC (rev 47985)
@@ -2169,31 +2169,23 @@
     return (0, "nothing to unpack");
   }
 
-  my $type;
+  my $decompressor;
   my $compressorextension;
-  for my $comptype (@AcceptedCompressors) {
-    my $ext = $CompressorExtension{$comptype};
-    if ($what =~  m/\.tar\.$ext$/) {
-      $type = $comptype;
-      $compressorextension = $ext;
-    }
+  if ($what =~ m/\.tar\.$CompressorExtRegexp$/) {
+    $compressorextension = $1;
+    $decompressor = $1 eq "gz" ? "gzip" : $1;
   }
-  if (!$type) {
+  if (!$decompressor) {
     return(0, "don't know how to unpack");
   }
   # make sure that the found uncompressor type is also available
-  if (!member($type, @{$::progs{'working_compressors'}})) {
-    return(0, "unsupported container format $type");
+  if (!member($decompressor, @{$::progs{'working_compressors'}})) {
+    return(0, "unsupported container format $decompressor");
   }
 
   # only check the necessary compressor program
-  my $decompressor = $::progs{$DecompressorProgram{$type}};
-  my @decompressorArgs = @{$DecompressorArgs{$type}};
-  if (!defined($decompressor)) {
-    return (0, "programs not set up properly");
-  }
+  my @decompressorArgs = @{$Compressors{$compressor}{'decompress_args'}};
 
-
   my $fn = basename($what);
   my $pkg = $fn;
   $pkg =~ s/\.tar\.$compressorextension$//;
@@ -2383,16 +2375,15 @@
   }
   $::progs{'working_downloaders'} = [ @working_downloaders ];
   my @working_compressors;
-  for my $comptype (@AcceptedCompressors) {
-    my $defprog = $CompressorProgram{$comptype};
+  for my $defprog (sort {$Compressors{$a}{'priority'} <=> $Compressors{$b}{'priority'}} keys %Compressors) {
     # do not warn on errors
     if (setup_one(($isWin ? "w32" : "unix"), $defprog,
-                  "$bindir/$comptype/$defprog.$platform", "--version", 1)) {
-      push @working_compressors, $comptype;
+                  "$bindir/$defprog/$defprog.$platform", "--version", 1)) {
+      push @working_compressors, $defprog;
       # also set up $::{'compressor'} if not already done
       # this selects the first one, but we might reset this depending on
       # TEXLIVE_COMPRESSOR setting, see below
-      defined($::progs{'compressor'}) || ($::progs{'compressor'} = $comptype);
+      defined($::progs{'compressor'}) || ($::progs{'compressor'} = $defprog);
     }
   }
   $::progs{'working_compressors'} = [ @working_compressors ];



More information about the tex-live-commits mailing list