missed files in patterns, sync

git-svn-id: svn://tug.org/texlive/trunk@62441 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 80 insertions, 8 deletions

diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
index da59e615dc9..42156139d08 100644
--- a/Build/source/texk/tests/TeXLive/TLConfig.pm
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -1,12 +1,12 @@
 # TeXLive::TLConfig.pm - module exporting configuration values
-# Copyright 2007-2021 Norbert Preining
+# Copyright 2007-2022 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
 use strict; use warnings;
 package TeXLive::TLConfig;
 
-my $svnrev = '$Revision: 62096 $';
+my $svnrev = '$Revision: 62232 $';
 my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
 sub module_revision { return $_modulerevision; }
 
@@ -61,7 +61,7 @@ BEGIN {
 
 # the year of our release, will be used in the location of the
 # network packages, and in menu names, and other places.
-our $ReleaseYear = 2021;
+our $ReleaseYear = 2022;
 
 # users can upgrade from this year to the current year; might be the
 # same as the release year, or any number of releases earlier.
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index 0422702109c..ad5d3033af6 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -7,7 +7,7 @@ use strict; use warnings;
 
 package TeXLive::TLUtils;
 
-my $svnrev = '$Revision: 62112 $';
+my $svnrev = '$Revision: 62431 $';
 my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
 sub module_revision { return $_modulerevision; }
 
@@ -39,8 +39,9 @@ C<TeXLive::TLUtils> - TeX Live infrastructure miscellany
   TeXLive::TLUtils::xchdir($dir);
   TeXLive::TLUtils::wsystem($msg,@args);
   TeXLive::TLUtils::xsystem(@args);
-  TeXLive::TLUtils::run_cmd($cmd);
+  TeXLive::TLUtils::run_cmd($cmd [, @envvars ]);
   TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @args);
+  TeXLive::TLUtils::diskfree($path);
 
 =head2 File utilities
 
@@ -231,6 +232,7 @@ BEGIN {
     &xsystem
     &run_cmd
     &system_pipe
+    &diskfree
     &announce_execute_actions
     &add_symlinks
     &remove_symlinks
@@ -257,7 +259,7 @@ BEGIN {
   @EXPORT = qw(setup_programs download_file process_logging_options
                tldie tlwarn info log debug ddebug dddebug debug
                debug_hash_str debug_hash
-               win32 xchdir xsystem run_cmd system_pipe sort_archs);
+               win32 xchdir xsystem run_cmd system_pipe diskfree sort_archs);
 }
 
 use Cwd;
@@ -501,7 +503,7 @@ sub platform_desc {
     'amd64-midnightbsd'=> 'MidnightBSD on x86_64',
     'amd64-netbsd'     => 'NetBSD on x86_64',
     'armel-linux'      => 'GNU/Linux on ARM',
-    'armhf-linux'      => 'GNU/Linux on ARMv6/RPi',
+    'armhf-linux'      => 'GNU/Linux on RPi(32-bit) and ARMv7',
     'hppa-hpux'        => 'HP-UX',
     'i386-cygwin'      => 'Cygwin on Intel x86',
     'i386-darwin'      => 'MacOSX legacy (10.5-10.6) on Intel x86',
@@ -730,16 +732,35 @@ sub xsystem {
   return $retval;
 }
 
-=item C<run_cmd($cmd)>
+=item C<run_cmd($cmd, @envvars)>
 
 Run shell command C<$cmd> and captures its output. Returns a list with CMD's
 output as the first element and the return value (exit code) as second.
 
+The C<@envvars> - if given - are variable name / value pairs set for the call
+and reset to their original value (or unset if not defined initially).
+
 =cut
 
 sub run_cmd {
   my $cmd = shift;
+  my %envvars = @_;
+  my %envvarsSetState;
+  my %envvarsValue;
+  for my $k (keys %envvars) {
+    $envvarsSetState{$k} = exists $ENV{$k};
+    $envvarsValue{$k} = $ENV{$k};
+    $ENV{$k} = $envvars{$k};
+  }
   my $output = `$cmd`;
+  for my $k (keys %envvars) {
+    if ($envvarsSetState{$k}) {
+      $ENV{$k} = $envvarsValue{$k};
+    } else {
+      delete $ENV{$k};
+    }
+  }
+
   $output = "" if ! defined ($output);  # don't return undef
 
   my $retval = $?;
@@ -781,6 +802,51 @@ sub system_pipe {
   }
 }
 
+=item C<diskfree($path)>
+
+If a POSIX compliant C<df> program is found, returns the number of
+Mb free at C<$path>, otherwise C<-1>. If C<$path> is not existent, go
+back up to two levels and check if any of the parents exists, and use
+the existing one for computing the disk space.
+
+=cut
+
+sub diskfree {
+  my $td = shift;
+  return (-1) if (! $::progs{"df"});
+  # drop final /
+  $td =~ s!/$!!;
+  if (! -e $td) {
+    my $ptd = dirname($td);
+    if (-e $ptd) {
+      $td = $ptd;
+    } else {
+      my $pptd = dirname($ptd);
+      if (-e $pptd) {
+        $td = $pptd;
+      }
+    }
+  }
+  $td .= "/" if ($td !~ m!/$!);
+  return (-1) if (! -e $td);
+  debug("Checking for free diskspace in $td\n");
+  my ($output, $retval) = run_cmd("df -P \"$td\"", POSIXLY_CORRECT => 1);
+  if ($retval == 0) {
+    # Output format should be this:
+    # Filesystem      512-blocks       Used  Available Capacity Mounted on
+    # /dev/sdb3       6099908248 3590818104 2406881416      60% /home
+    my ($h,$l) = split(/\n/, $output);
+    my ($fs, $nrb, $used, $avail, @rest) = split(' ', $l);
+    debug("disk space: used=$used (512-block), avail=$avail (512-block)\n");
+    # $avail is in 512 blocks, so we need to device by 2 * 1024 to obtain Mb
+    # require that at least 100M remain free
+    return (int($avail / 2024));
+  } else {
+    # error in running df -P out of whatever reason
+    return (-1);
+  }
+}
+
 =back
 
 =head2 File utilities
@@ -2615,6 +2681,8 @@ sub setup_programs {
     # tar needs to be provided by the system, we not even check!
     $::progs{'tar'} = "tar";
 
+    setup_one("unix", "df", undef, "-P .", 0);
+
     if (!defined($platform) || ($platform eq "")) {
       # we assume that we run from uncompressed media, so we can call
       # platform() and thus also the config.guess script but we have to
@@ -2792,6 +2860,10 @@ sub setup_windows_tl_one {
 #   . if the copy is -x and executable, use it
 sub setup_unix_tl_one {
   my ($p, $def, $arg) = @_;
+  if (!$def) {
+    debug("(unix) no default program for $p, no setup done\n");
+    return(1);
+  }
   our $tmp;
   debug("(unix) trying to set up $p, default $def, arg $arg\n");
   if (-r $def) {