summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm101
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm12
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);
}