texlive[47803] Master/tlpkg/TeXLive: get rid of xzdec requirement,

commits+preining at tug.org commits+preining at tug.org
Wed May 23 04:32:38 CEST 2018


Revision: 47803
          http://tug.org/svn/texlive?view=revision&revision=47803
Author:   preining
Date:     2018-05-23 04:32:38 +0200 (Wed, 23 May 2018)
Log Message:
-----------
get rid of xzdec requirement, use only xz

Modified Paths:
--------------
    trunk/Master/tlpkg/TeXLive/TLPDB.pm
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/tlpkg/TeXLive/TLPDB.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-23 02:32:29 UTC (rev 47802)
+++ trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-23 02:32:38 UTC (rev 47803)
@@ -32,7 +32,6 @@
   $tlpdb->save;
   $tlpdb->media;
   $tlpdb->available_architectures();
-  $tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] );
   $tlpdb->add_tlpobj($tlpobj);
   $tlpdb->needed_by($pkg);
   $tlpdb->remove_tlpobj($pkg);
@@ -320,9 +319,9 @@
       $tlpdbfile =~ s!/!\\!g;
     }
     $tlpdbfile_quote = "\"$tlpdbfile\"";
-    # if we have xzdec available we try the xz file
+    # if we have xz available we try the xz file
     my $xz_succeeded = 0 ;
-    if (defined($::progs{'xzdec'})) {
+    if (defined($::progs{$DefaultCompressorFormat})) {
       # we first try the xz compressed file
       my ($xzfh, $xzfile) = TeXLive::TLUtils::tl_tmpfile();
       close($xzfh);
@@ -331,31 +330,33 @@
         $xzfile  =~ s!/!\\!g;
       }
       $xzfile_quote = "\"$xzfile\"";
-      my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'});
-      debug("trying to download $path.xz to $xzfile\n");
-      my $ret = TeXLive::TLUtils::download_file("$path.xz", "$xzfile");
+      my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces($::progs{$DecompressorProgram{$DefaultCompressorFormat}});
+      my $compressorextension = $CompressorExtension{$DefaultCompressorFormat};
+      my @decompressorArgs = @{$DecompressorArgs{$DefaultCompressorFormat}};
+      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
       if ($ret && (-r "$xzfile")) {
         # ok, let the fun begin
-        debug("xzdec-ing $xzfile to $tlpdbfile\n");
+        debug("decompressing $xzfile to $tlpdbfile\n");
         # xzdec *hopefully* returns 0 on success and anything else on failure
         # we don't have to negate since not zero means error in the shell
         # and thus in perl true
-        if (system("$xzdec <$xzfile_quote >$tlpdbfile_quote")) {
-          debug("$xzdec $xzfile failed, trying plain file\n");
+        if (system("$decompressor @decompressorArgs <$xzfile_quote >$tlpdbfile_quote")) {
+          debug("$decompressor $xzfile failed, trying plain file\n");
           # to be sure we unlink the xz file and the tlpdbfile
           unlink($xzfile);
         } else {
           unlink($xzfile);
           $xz_succeeded = 1;
-          debug("found the uncompressed xz file\n");
+          debug("found the uncompressed $DefaultCompressorFormat file\n");
         }
       } 
     } else {
-      debug("no xzdec defined, not trying tlpdb.xz ...\n");
+      debug("no $DefaultCompressorFormat defined, not trying tlpdb.$compressorextension ...\n");
     }
     if (!$xz_succeeded) {
-      debug("TLPDB: downloading $path.xz didn't succeed, try $path\n");
+      debug("TLPDB: downloading $path.$compressorextension didn't succeed, try $path\n");
       my $ret = TeXLive::TLUtils::download_file($path, $tlpdbfile);
       # better to check both, the return value AND the existence of the file
       if ($ret && (-r $tlpdbfile)) {
@@ -691,82 +692,6 @@
 
 =pod
 
-=item C<< $tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] ) >>
-
-Installs the package C<$pkg> from the container files in C<$ziploc>. If
-C<$archrefs> is given then it must be a reference to a list of 
-architectures to be installed. If the normal (arch=all) package is
-architecture dependent then all arch packages in this list are installed.
-If C<$dest> is given then the files are
-installed into it, otherwise into the location of the TLPDB.
-
-Note that this procedure does NOT check for dependencies. So if your package
-adds new dependencies they are not necessarily fulfilled.
-
-=cut
-
-sub add_tlpcontainer {
-  my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
-  if ($self->is_virtual) {
-    tlwarn("TLPDB: cannot add_tlpcontainer to a virtual tlpdb\n");
-    return 0;
-  }
-  my @archs;
-  if (defined($archrefs)) {
-    @archs = @$archrefs;
-  }
-  my $cwd = getcwd();
-  if ($ziplocation !~ m,^/,) {
-    $ziplocation = "$cwd/$ziplocation";
-  }
-  my $tlpobj = $self->_add_tlpcontainer($package, $ziplocation, "all", $dest);
-  if ($tlpobj->is_arch_dependent) {
-    foreach (@$archrefs) {
-      $self->_add_tlpcontainer($package, $ziplocation, $_, $dest);
-    }
-  }
-}
-
-sub _add_tlpcontainer {
-  my ($self, $package, $ziplocation, $arch, $dest) = @_;
-  my $unpackprog;
-  my $args;
-  # WARNING: If you change the location of the texlive.tlpdb this
-  # has to be changed, too!!
-  if (not(defined($dest))) { 
-    $dest = $self->{'root'};
-  }
-  my $container = "$ziplocation/$package";
-  if ($arch ne "all") {
-    $container .= ".$arch";
-  }
-  if (-r "$container.zip") {
-    $container .= ".zip";
-    $unpackprog="unzip";
-    $args="-o -qq $container -d $dest";
-  } elsif (-r "$container.xz") {
-    $container .= ".xz";
-    $unpackprog="NO_IDEA_HOW_TO_UNPACK_LZMA";
-    $args="NO IDEA WHAT ARGS IT NEEDS";
-    die "$0: xz checked for but not implemented, maybe update TLPDB.pm";
-  } else {
-    die "$0: No package $container (.zip or .xz) in $ziplocation";
-  }
-  tlwarn("TLPDB: Hmmm, this needs testing and error checking!\n");
-  tlwarn("Should we use -a -- adapt line endings etc?\n");
-  `$unpackprog $args`;
-  # we only create/add tlpobj for arch eq "all"
-  if ($arch eq "all") {
-    my $tlpobj = new TeXLive::TLPOBJ;
-    $tlpobj->from_file("$dest/$InfraLocation/tlpobj/$package.tlpobj");
-    $self->add_tlpobj($tlpobj);
-    return $tlpobj;
-  }
-}
-
-
-=pod
-
 =item C<< $tlpdb->get_package("pkgname") >> 
 
 The C<get_package> function returns a reference to the C<TLPOBJ> object

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-23 02:32:29 UTC (rev 47802)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-23 02:32:38 UTC (rev 47803)
@@ -2329,7 +2329,6 @@
   my $ok = 1;
 
   $::progs{'wget'} = "wget";
-  $::progs{'xzdec'} = "xzdec";
   $::progs{'xz'} = "xz";
   $::progs{'tar'} = "tar";
   $::progs{'lz4'} = "lz4";
@@ -2337,15 +2336,13 @@
   if ($^O =~ /^MSWin/i) {
     $::progs{'wget'}  = conv_to_w32_path("$bindir/wget/wget.exe");
     $::progs{'tar'}   = conv_to_w32_path("$bindir/tar.exe");
-    $::progs{'xzdec'} = conv_to_w32_path("$bindir/xz/xzdec.exe");
     $::progs{'xz'}    = conv_to_w32_path("$bindir/xz/xz.exe");
     $::progs{'lz4'}   = conv_to_w32_path("$bindir/lz4/lz4.exe");
-    for my $prog ("xzdec", "wget") {
-      my $opt = $prog eq "xzdec" ? "--help" : "--version";
-      my $ret = system("$::progs{$prog} $opt >nul 2>&1"); # on windows
+    for my $prog ("xz", "wget") {
+      my $ret = system("$::progs{$prog} --version >nul 2>&1"); # on windows
       if ($ret != 0) {
         warn "TeXLive::TLUtils::setup_programs (w32) failed";  # no nl for perl
-        warn "$::progs{$prog} $opt failed (status $ret): $!\n";
+        warn "$::progs{$prog} --version failed (status $ret): $!\n";
         warn "Output is:\n";
         system ("$::progs{$prog} $opt");
         warn "\n";
@@ -2363,9 +2360,8 @@
     }
     my $s = 0;
     $s += setup_unix_one('wget', "$bindir/wget/wget.$platform", "--version");
-    $s += setup_unix_one('xzdec',"$bindir/xz/xzdec.$platform","--help");
     $s += setup_unix_one('xz',   "$bindir/xz/xz.$platform", "notest");
-    $ok = ($s == 3);  # failure return unless all are present.
+    $ok = ($s == 2);  # failure return unless all are present.
     # also try to set up lz4, but don't fail/warn
     setup_unix_one('lz4',  "$bindir/lz4/lz4.$platform", "--version", 1);
   }



More information about the tex-live-commits mailing list