From c3a88b73f1fea99c8e336b723504d93806d7ad4f Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 7 Jun 2018 16:07:17 +0900 Subject: code cleanup and streamlining (use %Compressors) --- Master/texmf-dist/scripts/texlive/tlmgr.pl | 57 +++++++++++++++++------------- Master/tlpkg/TeXLive/TLConfig.pm | 42 +++++++++++++--------- Master/tlpkg/TeXLive/TLPDB.pm | 24 ++++++------- Master/tlpkg/TeXLive/TLPOBJ.pm | 10 +++--- Master/tlpkg/TeXLive/TLUtils.pm | 33 +++++++---------- 5 files changed, 84 insertions(+), 82 deletions(-) (limited to 'Master') 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 -- 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 = ""; - 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 ]; -- cgit v1.2.3