From 863158ec2ac35ea8ee287722f678c3481d8c6f19 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 28 Aug 2019 10:29:01 +0900 Subject: TLPOBJ::make_container: convert arguments, pass user type as argument convert optional arguments to hash pass add user argument to determine user created container --- Master/texmf-dist/scripts/texlive/tlmgr.pl | 30 ++++++++++++++++++++---------- Master/tlpkg/TeXLive/TLPOBJ.pm | 19 +++++++++++++++---- Master/tlpkg/bin/tl-update-containers | 17 +++++++++++++---- 3 files changed, 48 insertions(+), 18 deletions(-) diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl index 590d4542853..f40260b2eea 100755 --- a/Master/texmf-dist/scripts/texlive/tlmgr.pl +++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl @@ -1095,9 +1095,10 @@ sub backup_and_remove_package { } if ($opts{"backup"}) { $tlp->make_container($::progs{'compressor'}, $localtlpdb->root, - $opts{"backupdir"}, - "${pkg}.r" . $tlp->revision, - $tlp->relocated); + destdir => $opts{"backupdir"}, + containername => "${pkg}.r" . $tlp->revision, + relative => $tlp->relocated, + user => 1); if ($autobackup) { # in case we do auto backups we remove older backups clear_old_backups($pkg, $opts{"backupdir"}, $autobackup); @@ -2164,7 +2165,9 @@ sub action_backup { $tlp->revision . ".tar.$compressorextension\n"); if (!$opts{"dry-run"}) { $tlp->make_container($::progs{'compressor'}, $localtlpdb->root, - $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); + destdir => $opts{"backupdir"}, + containername => "${pkg}.r" . $tlp->revision, + user => 1); } } } @@ -2280,7 +2283,10 @@ sub write_w32_updater { push (@rst_info, "$pkg ^($oldrev^)"); next if ($opts{"dry-run"}); # create backup; make_container expects file name in a format: some-name.r[0-9]+ - my ($size, undef, $fullname) = $localtlp->make_container("tar", $root, $temp, "__BACKUP_$pkg.r$oldrev"); + my ($size, undef, $fullname) = $localtlp->make_container("tar", $root, + destdir => $temp, + containername => "__BACKUP_$pkg.r$oldrev", + user => 1); if ($size <= 0) { tlwarn("$prg: Creation of backup container of $pkg failed.\n"); return 1; # backup failed? abort @@ -3200,8 +3206,10 @@ sub action_update { if ($opts{"backup"} && !$opts{"dry-run"}) { my $compressorextension = $Compressors{$::progs{'compressor'}}{'extension'}; $tlp->make_container($::progs{'compressor'}, $root, - $opts{"backupdir"}, "${pkg}.r" . $tlp->revision, - $tlp->relocated); + destdir => $opts{"backupdir"}, + containername => "${pkg}.r" . $tlp->revision, + relative => $tlp->relocated, + user => 1); $unwind_package = "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.$compressorextension"; @@ -3239,9 +3247,11 @@ sub action_update { # no backup was made, so let us create a temporary .tar file # of the package my $tlp = $localtlpdb->get_package($pkg); - my ($s, undef, $fullname) = $tlp->make_container("tar", $root, $temp, - "__BACKUP_${pkg}.r" . $tlp->revision, - $tlp->relocated); + my ($s, undef, $fullname) = $tlp->make_container("tar", $root, + destdir => $temp, + containername => "__BACKUP_${pkg}.r" . $tlp->revision, + relative => $tlp->relocated, + user => 1); if ($s <= 0) { tlwarn("\n$prg: Creation of backup container of $pkg failed.\n"); tlwarn("$prg: Continuing to update other packages, please retry...\n"); diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 55ead17b769..7b00afe5dc2 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -559,7 +559,11 @@ sub common_texmf_tree { sub make_container { - my ($self,$type,$instroot,$destdir,$containername,$relative) = @_; + my ($self, $type, $instroot, %other) = @_; + my $destdir = ($other{'destdir'} || undef); + my $containername = ($other{'containername'} || undef); + my $relative = ($other{'relative'} || undef); + my $user = ($other{'user'} || undef); if (!($type eq 'tar' || TeXLive::TLUtils::member($type, @{$::progs{'working_compressors'}}))) { tlwarn "$0: TLPOBJ supports @{$::progs{'working_compressors'}} and tar containers, not $type\n"; @@ -638,6 +642,7 @@ sub make_container { $containername = $tarname; + # OLD COMMENTS, SEE BELOW FOR CURRENT STATUS # Here we need to distinguish between making the master containers for # tlnet (where we can assume GNU tar) and making backups on a user's # machine (where we can assume nothing). We determine this by whether @@ -649,7 +654,10 @@ sub make_container { # overflow standard tar format and result in special things being # done. We don't want the GNU-specific special things. # - my $is_user_container = ( $containername =~ /\.r[0-9]/ ); + # my $is_user_container = ( $containername =~ /\.r[0-9]/ ); + # + # We use versioned containers throughout, user is determined by argument + my $is_user_container = $user; my @attrs = $is_user_container ? () @@ -1663,7 +1671,7 @@ if all files of the package are from the same texmf tree, this tree is returned, otherwise an undefined value. That is also a check whether a package is relocatable. -=item C +=item C $destdir, containername => $containername, relative => 0|1, user => 0|1 ])> creates a container file of the all files in the C in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used). @@ -1683,7 +1691,7 @@ C file in C. The argument C<$instroot> specifies the root of the installation from which the files should be taken. -If the argument C<$relative> is present and true (perlish true) AND the +If the argument C<$relative> is passed and true (perlish true) AND the packages does not span multiple texmf trees (i.e., all the first path components of all files are the same) then a relative packages is created, i.e., the first path component is stripped. In this case the tlpobj file @@ -1692,6 +1700,9 @@ is placed into the root of the installation. This is used to distribute packages which can be installed in any arbitrary texmf tree (of other distributions, too). +If user is present and true, no extra arguments for container generation are +passed to tar (to make sure that user tar doesn't break). + Return values are the size, the checksum, and the full name of the container. =item C diff --git a/Master/tlpkg/bin/tl-update-containers b/Master/tlpkg/bin/tl-update-containers index 651b477a810..bc90c0544e9 100755 --- a/Master/tlpkg/bin/tl-update-containers +++ b/Master/tlpkg/bin/tl-update-containers @@ -298,7 +298,10 @@ sub main { $objcopy->clear_srcfiles; if ($objsrc) { my ($s,$m) = $objsrc->make_container($type, $Master, - $opt_containerdir, "$pkg.source", $do_relative); + destdir => $opt_containerdir, + containername => "$pkg.source", + relative => $do_relative, + user => 0); if ($s > 0) { # something was created # important, we have to add it to the original $obj @@ -322,7 +325,10 @@ sub main { $objcopy->clear_docfiles; if ($objdoc) { my ($s,$m) = $objdoc->make_container($type, $Master, - $opt_containerdir, "$pkg.doc", $do_relative); + destdir => $opt_containerdir, + containername => "$pkg.doc", + relative => $do_relative, + user => 0); if ($s > 0) { # something was created $obj->doccontainersize($s); @@ -340,8 +346,11 @@ sub main { push @removecontainers, "$pkg.doc"; } if (!$opt_dry) { - my ($s,$m) = $objcopy->make_container($type, $Master, $opt_containerdir, - $pkg, $do_relative); + my ($s,$m) = $objcopy->make_container($type, $Master, + destdir => $opt_containerdir, + containername => $pkg, + relative => $do_relative, + user => 0); if ($s > 0) { $obj->containersize($s); } -- cgit v1.2.3