sync

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

2 files changed, 109 insertions, 79 deletions

diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
index 4e0855319b8..573efa08d56 100644
--- a/Build/source/texk/tests/TeXLive/TLConfig.pm
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -1,4 +1,3 @@
-# $Id: TLConfig.pm 34040 2014-05-15 12:16:59Z siepo $
 # TeXLive::TLConfig.pm - module exporting configuration values
 # Copyright 2007-2014 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
@@ -6,7 +5,7 @@
 
 package TeXLive::TLConfig;
 
-my $svnrev = '$Revision: 34040 $';
+my $svnrev = '$Revision: 35731 $';
 my $_modulerevision;
 if ($svnrev =~ m/: ([0-9]+) /) {
   $_modulerevision = $1;
@@ -59,10 +58,10 @@ $ReleaseYear = 2014;
 
 # users can upgrade from this year to the current year; maybe a spread
 # of more than one year will be useful at some point, but not now.
-# $MinRelease = $ReleaseYear - 1;
+$MinRelease = 2013; # upgrade from 2013 to 2015 might work?
 
 # users can NOT upgrade due to internal changes, force a full installation
-$MinRelease = $ReleaseYear;
+#$MinRelease = $ReleaseYear;
 
 # Meta Categories do not ship files, but only call for other packages.
 our @MetaCategories = qw/Collection Scheme/;
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index eeeaf92144d..ab940e6b93e 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -5,7 +5,7 @@
 
 package TeXLive::TLUtils;
 
-my $svnrev = '$Revision: 35578 $';
+my $svnrev = '$Revision: 35719 $';
 my $_modulerevision;
 if ($svnrev =~ m/: ([0-9]+) /) {
   $_modulerevision = $1;
@@ -26,7 +26,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
 
   use TeXLive::TLUtils;
 
-=head2 Platform Detection
+=head2 Platform detection
 
   TeXLive::TLUtils::platform();
   TeXLive::TLUtils::platform_name($canonical_host);
@@ -34,17 +34,18 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
   TeXLive::TLUtils::win32();
   TeXLive::TLUtils::unix();
 
-=head2 System Tools
+=head2 System tools
 
   TeXLive::TLUtils::getenv($string);
   TeXLive::TLUtils::which($string);
   TeXLive::TLUtils::get_system_tmpdir();
   TeXLive::TLUtils::tl_tmpdir();
   TeXLive::TLUtils::xchdir($dir);
+  TeXLive::TLUtils::wsystem($msg,@args);
   TeXLive::TLUtils::xsystem(@args);
   TeXLive::TLUtils::run_cmd($cmd);
 
-=head2 File Utilities
+=head2 File utilities
 
   TeXLive::TLUtils::dirname($path);
   TeXLive::TLUtils::basename($path);
@@ -64,7 +65,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
   TeXLive::TLUtils::nulldev();
   TeXLive::TLUtils::get_full_line($fh);
 
-=head2 Installer Functions
+=head2 Installer functions
 
   TeXLive::TLUtils::make_var_skeleton($path);
   TeXLive::TLUtils::make_local_skeleton($path);
@@ -174,6 +175,7 @@ BEGIN {
     &create_mirror_list
     &extract_mirror_entry
     &tlmd5
+    &wsystem
     &xsystem
     &run_cmd
     &announce_execute_actions
@@ -206,8 +208,8 @@ use TeXLive::TLConfig;
 
 $::opt_verbosity = 0;  # see process_logging_options
 
-
-=head2 Platform Detection
+
+=head2 Platform detection
 
 =over 4
 
@@ -482,7 +484,7 @@ sub get_system_tmpdir {
 
 =item C<tl_tmpdir>
 
-Create a temporary directory which is cleaned up as soon as the program
+Create a temporary directory which is removed when the program
 is terminated.
 
 =cut
@@ -504,9 +506,28 @@ sub xchdir {
 }
 
 
+=item C<wsystem($msg, @args)>
+
+Call C<info> about what is being done starting with C<$msg>, then run
+C<system(@args)>; C<tlwarn> if unsuccessful and return the exit status.
+
+=cut
+
+sub wsystem {
+  my ($msg,@args) = @_;
+  info("$msg @args ...\n");
+  my $status = system(@args);
+  if ($status != 0) {
+    tlwarn("$0:  command failed: @args: $!\n");
+  }
+  return $status;
+}
+
+
 =item C<xsystem(@args)>
 
-Run C<system(@args)> and die if unsuccessful.
+Call C<ddebug> about what is being done, then run C<system(@args)>, and
+die if unsuccessful.
 
 =cut
 
@@ -523,7 +544,7 @@ sub xsystem {
 
 =item C<run_cmd($cmd)>
 
-runs shell CMD and captures its output. Returns a list with CMD's
+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.
 
 =cut
@@ -541,8 +562,6 @@ sub run_cmd {
 }
 
 
-
-
 =back
 
 =head2 File Utilities
@@ -714,28 +733,30 @@ a fileserver.
 # real Program Files. Ugh.
 
 sub dir_writable {
-  my $path=shift;
+  my ($path) = @_;
   return 0 unless -d $path;
   $path =~ s!\\!/!g if win32;
   $path =~ s!/$!!;
   my $i = 0;
   my $too_large = 100000;
-  while ((-e $path . "/" . $i) and $i<$too_large) { $i++; }
-  return 0 if $i>=$too_large;
-  my $f = $path."/".$i;
-  return 0 unless open TEST, ">".$f;
+  while ((-e "$path/$i") && $i < $too_large) {
+    $i++;
+  }
+  return 0 if $ i >= $too_large;
+  my $f = "$path/$i";
+  return 0 if ! open (TEST, ">$f");
   my $written = 0;
   $written = (print TEST "\n");
-  close TEST;
-  unlink $f;
+  close (TEST);
+  unlink ($f);
   return $written;
 }
 
 
 =item C<mkdirhier($path, [$mode])>
 
-The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
-The optional parameter sets the permission flags.
+The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>,
+and dies on failure.  The optional parameter sets the permission bits.
 
 =cut
 
@@ -1044,9 +1065,6 @@ sub touch {
   }
 }
 
-
-
-
 
 =item C<collapse_dirs(@files)>
 
@@ -1991,27 +2009,38 @@ On Windows it returns undefined.
 =cut
 
 sub add_link_dir_dir {
-  my ($from, $to) = @_;
-  mkdirhier $to;
-  if (-w  $to) {
-    debug("linking files from $from to $to\n");
+  my ($from,$to) = @_;
+  mkdirhier ($to);
+  if (-w $to) {
+    debug ("linking files from $from to $to\n");
     chomp (@files = `ls "$from"`);
     my $ret = 1;
     for my $f (@files) {
-      # skip certain dangerous entries that should never be linked somewhere
+      # don't make a system-dir link to our special "man" link.
       if ($f eq "man") {
-        debug("not linking man into $to.\n");
+        debug ("not linking `man' into $to.\n");
+        next;
+      }
+      #
+      # attempt to remove an existing symlink, but nothing else.
+      unlink ("$to/$f") if -l "$to/$f";
+      #
+      # if the destination still exists, skip it.
+      if (-e "$to/$f") {
+        tlwarn ("add_link_dir_dir: $to/$f exists; not making symlink.\n");
         next;
       }
-      unlink("$to/$f");
-      if (system("ln -s \"$from/$f\" \"$to\"")) {
-        tlwarn("Linking $f from $from to $to failed: $!\n");
+      #
+      # try to make the link.
+      if (system ("ln -s '$from/$f' '$to'") != 0) {
+        tlwarn ("add_link_dir_dir: linking $f from $from to $to failed: $!\n");
         $ret = 0;
       }
     }
     return $ret;
   } else {
-    tlwarn("destination $to not writable, no linking files in $from done.\n");
+    tlwarn ("add_link_dir_dir: destination $to not writable, "
+            . "no links from $from.\n");
     return 0;
   }
 }
@@ -2050,58 +2079,65 @@ sub add_remove_symlinks {
   my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_;
   my $errors = 0;
   my $plat_bindir = "$Master/bin/$arch";
+
+  # nothing to do with symlinks on Windows, of course.
   return if win32();
+
+  my $info_dir = "$Master/texmf-dist/doc/info";
   if ($mode eq "add") {
-    $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
-    if (-d "$Master/texmf-dist/doc/info") {
-      $errors++
-        unless add_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info);
+    $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);   # bin
+    if (-d $info_dir) {
+      $errors++ unless add_link_dir_dir($info_dir, $sys_info);
     }
   } elsif ($mode eq "remove") {
-    $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
-    if (-d "$Master/texmf-dist/doc/info") {
-      $errors++
-        unless remove_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info);
+    $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin); # bin
+    if (-d $info_dir) {
+      $errors++ unless remove_link_dir_dir($info_dir, $sys_info);
     }
   } else {
     die ("should not happen, unknown mode $mode in add_remove_symlinks!");
   }
-  mkdirhier $sys_man if ($mode eq "add");
-  if (-w  $sys_man && -d "$Master/texmf-dist/doc/man") {
-    debug("$mode symlinks for man pages in $sys_man\n");
-    my $foo = `(cd "$Master/texmf-dist/doc/man" && echo *)`;
-    my @mans = split (' ', $foo);
-    chomp (@mans);
-    foreach my $m (@mans) {
-      my $mandir = "$Master/texmf-dist/doc/man/$m";
-      next unless -d $mandir;
-      if ($mode eq "add") {
-        $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
-      } else {
-        $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+  
+  # man
+  my $top_man_dir = "$Master/texmf-dist/doc/man";
+  debug("$mode symlinks for man pages to $sys_man from $top_man_dir\n");
+  if (! -d $top_man_dir && $mode eq "add") {
+    ; # better to be silent?
+    #info("skipping add of man symlinks, no source directory $top_man_dir\n");
+  } else {
+    mkdirhier $sys_man if ($mode eq "add");
+    if (-w $sys_man) {
+      my $foo = `(cd "$top_man_dir" && echo *)`;
+      my @mans = split (' ', $foo);
+      chomp (@mans);
+      foreach my $m (@mans) {
+        my $mandir = "$top_man_dir/$m";
+        next unless -d $mandir;
+        if ($mode eq "add") {
+          $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
+        } else {
+          $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+        }
       }
+      #`rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
+    } else {
+      tlwarn("man symlink destination ($sys_man) not writable,"
+        . "cannot $mode symlinks.\n");
+      $errors++;
     }
-    # `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
-  } else {
-    tlwarn("destination of man symlink $sys_man not writable, "
-      . "cannot $mode symlinks.\n");
-    $errors++;
   }
-  # we collected errors in $ret, so return the negation of it
+  
+  # we collected errors in $errors, so return the negation of it
   if ($errors) {
-    info("$mode of symlinks failed $errors times, please see above messages.\n");
+    info("$mode of symlinks had $errors error(s), see messages above.\n");
     return 0;
   } else {
     return 1;
   }
 }
 
-sub add_symlinks {
-  return (add_remove_symlinks("add", @_));
-}
-sub remove_symlinks {
-  return (add_remove_symlinks("remove", @_));
-}
+sub add_symlinks    { return (add_remove_symlinks("add", @_));    }
+sub remove_symlinks { return (add_remove_symlinks("remove", @_)); }
 
 =pod
 
@@ -2351,7 +2387,6 @@ sub read_file_ignore_cr {
   return $ret;
 }
 
-
 
 =item C<setup_programs($bindir, $platform)>
 
@@ -2672,7 +2707,7 @@ sub get_full_line {
   return $line . $cont;
 }
 
-
+
 =back
 
 =head2 Installer Functions
@@ -2727,7 +2762,6 @@ sub make_local_skeleton {
   mkdirhier "$prefix/web2c";
 }
 
-
 
 =item C<create_fmtutil($tlpdb, $dest, $localconf)>
 
@@ -3073,7 +3107,7 @@ sub parse_AddFormat_line {
   return %ret;
 }
 
-
+
 =back
 
 =head2 Miscellaneous
@@ -3929,8 +3963,6 @@ sub sort_archs ($$) {
   $aa cmp $bb ;
 }
 
-#############################################
-#
 # Taken from Text::ParseWords
 #
 sub quotewords {
@@ -4085,7 +4117,6 @@ sub mktexupd {
   return $hash;
 }
 
-
 =back
 =cut
 1;