summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2018-06-07 16:07:17 +0900
committerNorbert Preining <norbert@preining.info>2018-06-11 10:31:27 +0900
commitc3a88b73f1fea99c8e336b723504d93806d7ad4f (patch)
tree84da5b28e7a9b0ff55b5d534771084ee558b44d8
parentde7c6a9c11e0edf5ce8a99d7c9338a05d9ddc5ef (diff)
code cleanup and streamlining (use %Compressors)
-rwxr-xr-xMaster/texmf-dist/scripts/texlive/tlmgr.pl57
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm42
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm24
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm10
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm33
5 files changed, 84 insertions, 82 deletions
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;
diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index 495a316b0c0..1522a08b0b8 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -27,14 +27,8 @@ BEGIN {
%FallbackDownloaderProgram
%FallbackDownloaderArgs
$DefaultCompressorFormat
- $DefaultContainerExtension
- @AcceptedCompressors
- $AcceptedCompressorsRegexp
- %CompressorProgram
- %DecompressorProgram
- %CompressorArgs
- %DecompressorArgs
- %CompressorExtension
+ $CompressorExtRegexp
+ %Compressors
$InfraLocation
$DatabaseName
$PackageBackupDir
@@ -129,15 +123,29 @@ our %FallbackDownloaderArgs = (
);
# 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
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 78cbe489323..07ad80c6169 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -91,9 +91,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
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 @@ sub from_file {
# 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 @@ sub not_virtual_install_package {
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 @@ sub not_virtual_install_package {
# - 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 @@ sub _install_data {
}
# 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";
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 32160a2c811..43ccd889bd6 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -12,9 +12,7 @@ sub module_revision { return $_modulerevision; }
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 @@ sub make_container {
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");
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index da59eb99bdd..077d6015f5a 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -2169,30 +2169,22 @@ sub unpack {
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;
@@ -2383,16 +2375,15 @@ sub setup_programs {
}
$::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 ];