diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 101 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 12 |
2 files changed, 17 insertions, 96 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 99050e34dd7..d2cd1edefda 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -32,7 +32,6 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages $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 @@ sub from_file { $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 @@ sub from_file { $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 @@ sub _available_architectures { =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 diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 76c73abcb8b..d2492f15b60 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -2329,7 +2329,6 @@ sub setup_programs { my $ok = 1; $::progs{'wget'} = "wget"; - $::progs{'xzdec'} = "xzdec"; $::progs{'xz'} = "xz"; $::progs{'tar'} = "tar"; $::progs{'lz4'} = "lz4"; @@ -2337,15 +2336,13 @@ sub setup_programs { 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 @@ sub setup_programs { } 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); } |