summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2021-12-07 03:01:53 +0000
committerNorbert Preining <norbert@preining.info>2021-12-07 03:01:53 +0000
commit6336c19969656f3ee5f0b0fed00aaf64369a40e7 (patch)
tree93ac1bef29345070342f1e9c4290d7ddb201e486 /systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
parent51bc8dcf794519b64c5c4a92dd3c09097025167f (diff)
CTAN sync 202112070301
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm61
1 files changed, 36 insertions, 25 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
index 0e9425d2c0..6c0eae7122 100644
--- a/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
+++ b/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
@@ -1,12 +1,14 @@
-# $Id: TLUtils.pm 60823 2021-10-21 18:17:33Z karl $
+# $Id: TLUtils.pm 61225 2021-12-05 23:21:54Z karl $
# TeXLive::TLUtils.pm - the inevitable utilities for TeX Live.
# Copyright 2007-2021 Norbert Preining, Reinhard Kotucha
# This file is licensed under the GNU General Public License version 2
# or any later version.
+use strict; use warnings;
+
package TeXLive::TLUtils;
-my $svnrev = '$Revision: 60823 $';
+my $svnrev = '$Revision: 61225 $';
my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
sub module_revision { return $_modulerevision; }
@@ -128,15 +130,23 @@ C<TeXLive::TLUtils> - TeX Live infrastructure miscellany
# avoid -warnings.
our $PERL_SINGLE_QUOTE; # we steal code from Text::ParseWords
-use vars qw(
- $::LOGFILE $::LOGFILENAME @::LOGLINES
- @::debug_hook @::ddebug_hook @::dddebug_hook @::info_hook
- @::install_packages_hook @::warn_hook
- $TeXLive::TLDownload::net_lib_avail
- $::checksum_method $::gui_mode $::machinereadable $::no_execute_actions
- $::regenerate_all_formats
- $JSON::false $JSON::true
-);
+
+# We use myriad global and package-global variables, unfortunately.
+# To avoid "used only once" warnings, we must use the variable names
+# again; one way to do that would be to assign them all to themselves in
+# the BEGIN block, but this seems (slightly) less ugly.
+# Example in first reply to: https://perlmonks.org/?node_id=11139324
+#
+# Because we are providing a block to the package command, the scope is
+# limited to that block, so the current real package ends up unaffected.
+package main {
+ our ($LOGFILE, $LOGFILENAME, @LOGLINES,
+ @debug_hook, @ddebug_hook, @dddebug_hook, @info_hook,
+ @install_packages_hook, @warn_hook,
+ $checksum_method, $gui_mode, $machinereadable,
+ $no_execute_actions, $regenerate_all_formats); }
+package JSON { our ($false, $true); }
+package TeXLive::TLDownload { our $net_lib_avail; }
BEGIN {
use Exporter ();
@@ -967,7 +977,7 @@ sub mkdirhier {
# from the UNC path, since (! -d //servername/) tests true
$subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
- @dirs = split (/[\/\\]/, $tree);
+ my @dirs = split (/[\/\\]/, $tree);
for my $dir (@dirs) {
$subdir .= "$dir/";
if (! -d $subdir) {
@@ -1279,11 +1289,11 @@ sub copy {
chmod ($mode, $outfile) || warn "chmod($mode,$outfile) failed: $!";
- while ($read = sysread (IN, $buffer, $blocksize)) {
+ while (my $read = sysread (IN, $buffer, $blocksize)) {
die "read($infile) failed: $!" unless defined $read;
$offset = 0;
while ($read) {
- $written = syswrite (OUT, $buffer, $read, $offset);
+ my $written = syswrite (OUT, $buffer, $read, $offset);
die "write($outfile) failed: $!" unless defined $written;
$read -= $written;
$offset += $written;
@@ -1521,7 +1531,7 @@ sub time_estimate {
$min %= 60;
}
my $sec = $remsecs % 60;
- $remtime = sprintf("%02d:%02d", $min, $sec);
+ my $remtime = sprintf("%02d:%02d", $min, $sec);
if ($hour) {
$remtime = sprintf("%02d:$remtime", $hour);
}
@@ -1532,7 +1542,7 @@ sub time_estimate {
$tmin %= 60;
}
my $tsec = $esttotalsecs % 60;
- $tottime = sprintf("%02d:%02d", $tmin, $tsec);
+ my $tottime = sprintf("%02d:%02d", $tmin, $tsec);
if ($thour) {
$tottime = sprintf("%02d:$tottime", $thour);
}
@@ -2058,7 +2068,7 @@ sub add_link_dir_dir {
}
if (-w $to) {
debug ("TLUtils::add_link_dir_dir: linking from $from to $to\n");
- chomp (@files = `ls "$from"`);
+ chomp (my @files = `ls "$from"`);
my $ret = 1;
for my $f (@files) {
# don't make a system-dir link to our special "man" link.
@@ -2094,7 +2104,7 @@ sub remove_link_dir_dir {
my ($from, $to) = @_;
if ((-d "$to") && (-w "$to")) {
debug("TLUtils::remove_link_dir_dir: removing links from $from to $to\n");
- chomp (@files = `ls "$from"`);
+ chomp (my @files = `ls "$from"`);
my $ret = 1;
foreach my $f (@files) {
next if (! -r "$to/$f");
@@ -2655,11 +2665,11 @@ END_COMPRESSOR_BAD
if ($::opt_verbosity >= 2) {
require Data::Dumper;
- use vars qw($Data::Dumper::Indent $Data::Dumper::Sortkeys
- $Data::Dumper::Purity); # -w pain
- $Data::Dumper::Indent = 1;
- $Data::Dumper::Sortkeys = 1; # stable output
- $Data::Dumper::Purity = 1; # recursive structures must be safe
+ # avoid spurious "used only once" warnings due to require
+ # (warnings restored at end of scope):
+ no warnings 'once';
+ local $Data::Dumper::Sortkeys = 1; # stable output
+ local $Data::Dumper::Purity = 1; # reconstruct recursive structures
print STDERR "DD:dumping ";
print STDERR Data::Dumper->Dump([\%::progs], [qw(::progs)]);
}
@@ -3650,7 +3660,7 @@ Return call(er) stack, as a string.
sub backtrace {
my $ret = "";
- my ($line, $subr);
+ my ($filename, $line, $subr);
my $stackframe = 1; # skip ourselves
while ((undef,$filename,$line,$subr) = caller ($stackframe)) {
# the undef is for the package, which is already included in $subr.
@@ -4276,6 +4286,7 @@ Returns the local file name if succeeded, otherwise undef.
sub download_to_temp_or_file {
my $url = shift;
+ my $ret;
my ($url_fh, $url_file);
if ($url =~ m,^(https?|ftp|file)://, || $url =~ m!$SshURIRegex!) {
($url_fh, $url_file) = tl_tmpfile();
@@ -4644,7 +4655,7 @@ sub mktexupd {
foreach my $db (@texmfdbs) {
$db=substr($db, -1) if ($db=~m|/$|); # strip leading /
$db = lc($db) if win32();
- $up = (win32() ? lc($path) : $path);
+ my $up = (win32() ? lc($path) : $path);
if (substr($up, 0, length("$db/")) eq "$db/") {
# we appended a / because otherwise "texmf" is recognized as a
# substring of "texmf-dist".