setup_programs: prefer system versions, simplify code

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

1 files changed, 82 insertions, 109 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index c4d21e26cb9..64ede174800 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -2344,16 +2344,18 @@ Return 0 if failure, nonzero if success.
 =cut
 
 sub setup_programs {
-  my ($bindir, $platform) = @_;
+  my ($bindir, $platform, $tlfirst) = @_;
   my $ok = 1;
 
+  debug("setup_programs: preferring " . ($tlfirst ? "TL" : "system") . " versions\n");
+
   my $isWin = ($^O =~ /^MSWin/i);
 
   if ($isWin) {
-    setup_windows_one('tar', "$bindir/tar.exe", "--version", 1);
+    setup_one("w32", 'tar', "$bindir/tar.exe", "--version", $tlfirst);
     $platform = "exe";
   } else {
-    # tar needs to be provided by the system!
+    # tar needs to be provided by the system, we not even check!
     $::progs{'tar'} = "tar";
 
     if (!defined($platform) || ($platform eq "")) {
@@ -2372,14 +2374,14 @@ sub setup_programs {
     # do not warn on errors
     push @working_downloaders, $dltype if 
       setup_one(($isWin ? "w32" : "unix"), $defprog,
-                 "$bindir/$dltype/$defprog.$platform", "--version", 1);
+                 "$bindir/$dltype/$defprog.$platform", "--version", $tlfirst);
   }
   $::progs{'working_downloaders'} = [ @working_downloaders ];
   my @working_compressors;
   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/$defprog/$defprog.$platform", "--version", 1)) {
+                  "$bindir/$defprog/$defprog.$platform", "--version", $tlfirst)) {
       push @working_compressors, $defprog;
       # also set up $::{'compressor'} if not already done
       # this selects the first one, but we might reset this depending on
@@ -2422,7 +2424,7 @@ END_COMPRESSOR_BAD
     $::progs{'compressor'} = $ENV{'TEXLIVE_COMPRESSOR'};
   }
 
-  if ($::opt_verbosity >= 2) {
+  if ($::opt_verbosity >= 1) {
     require Data::Dumper;
     use vars qw($Data::Dumper::Indent $Data::Dumper::Sortkeys
                 $Data::Dumper::Purity); # -w pain
@@ -2436,149 +2438,120 @@ END_COMPRESSOR_BAD
 }
 
 sub setup_one {
-  my ($what, $p, $def, $arg, $donotwarn) = @_;
-  if ($what eq "unix") {
-    return(setup_unix_one($p, $def, $arg, $donotwarn));
+  my ($what, $p, $def, $arg, $tlfirst) = @_;
+  my $setupfunc = ($what eq "unix") ? \&setup_unix_tl_one : \&setup_windows_tl_one ;
+  if ($tlfirst) {
+    if (&$setupfunc($p, $def, $arg)) {
+      return(1);
+    } else {
+      return(setup_system_one($p, $arg));
+    }
+  } else {
+    if (setup_system_one($p, $arg)) {
+      return(1);
+    } else {
+      return(&$setupfunc($p, $def, $arg));
+    }
+  }
+}
+
+sub setup_system_one {
+  my ($p, $arg) = @_;
+  my $nulldev = nulldev();
+  my $ret = system("$p $arg >$nulldev 2>&1");
+  if ($ret == 0) {
+    debug("program $p found in the path\n");
+    $::progs{$p} = $p;
+    return(1);
   } else {
-    return(setup_windows_one($p, $def, $arg, $donotwarn));
+    return(0);
   }
 }
 
-sub setup_windows_one {
-  my ($p, $def, $arg, $donotwarn) = @_;
+sub setup_windows_tl_one {
+  my ($p, $def, $arg) = @_;
   debug("(w32) trying to set up $p, default $def, arg $arg\n");
-  my $ready = 0;
+
   if (-r $def) {
     my $prog = conv_to_w32_path($def);
     my $ret = system("$prog $arg >nul 2>&1"); # on windows
     if ($ret == 0) {
       $::progs{$p} = $prog;
-      $ready = 1;
+      return(1);
     } else {
       tlwarn("Setting up $p with $def as $prog didn't work\n");
       system("$prog $arg");
+      return(0);
     }
   } else {
     debug("Default program $def not readable?\n");
+    return(0);
   }
-  return($ready) if ($ready);
-  # still here, try plain name without any specification
-  debug("trying to test for plain prog name $p\n");
-  $ret = system("$p $arg >nul 2>&1");
-  if ($ret == 0) {
-    debug("program $p seems to be in the path!\n");
-    $::progs{$p} = $p;
-    return(1);
-  }
-  return(0);
 }
 
 
-
 # setup one prog on unix using the following logic:
 # - if the shipped one is -x and can be executed, use it
 # - if the shipped one is -x but cannot be executed, copy it. set -x
 #   . if the copy is -x and executable, use it
-#   . if the copy is not executable, GOTO fallback
 # - if the shipped one is not -x, copy it, set -x
 #   . if the copy is -x and executable, use it
-#   . if the copy is not executable, GOTO fallback
-# - if nothing shipped, GOTO fallback
-#
-# fallback:
-# if prog is found in PATH and can be executed, use it.
-#
-# Return 0 if failure, 1 if success.
-#
-sub setup_unix_one {
-  my ($p, $def, $arg, $donotwarn) = @_;
+sub setup_unix_tl_one {
+  my ($p, $def, $arg) = @_;
   our $tmp;
-  my $test_fallback = 0;
-  ddebug("trying to set up $p, default $def, arg $arg\n");
+  debug("(unix) trying to set up $p, default $def, arg $arg\n");
   if (-r $def) {
-    my $ready = 0;
     if (-x $def) {
       ddebug("default $def has executable permissions\n");
       # we have to check for actual "executability" since a "noexec"
       # mount option may interfere, which is not taken into account by -x.
-      $::progs{$p} = $def;
-      if ($arg ne "notest") {
-        my $ret = system("'$def' $arg >/dev/null 2>&1" ); # we are on Unix
-        if ($ret == 0) {
-          $ready = 1;
-          debug("Using shipped $def for $p (tested).\n");
-        } else {
-          ddebug("Shipped $def has -x but cannot be executed, "
-                 . "trying tmp copy.\n");
-        }
-      } else {
-        # do not test, just return
-        $ready = 1;
-        debug("Using shipped $def for $p (not tested).\n");
-      }
-    }
-    if (!$ready) {
-      # out of some reasons we couldn't execute the shipped program
-      # try to copy it to a temp directory and make it executable
-      #
-      # create tmp dir only when necessary
-      $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp);
-      # probably we are running from uncompressed media and want to copy it to
-      # some temporary location
-      copy($def, $tmp);
-      my $bn = basename($def);
-      $::progs{$p} = "$tmp/$bn";
-      chmod(0755,$::progs{$p});
-      # we do not check the return value of chmod, but check whether
-      # the -x bit is now set, the only thing that counts
-      if (! -x $::progs{$p}) {
-        # hmm, something is going really bad, not even the copy is
-        # executable. Fall back to normal path element
-        $test_fallback = 1;
-        ddebug("Copied $p $::progs{$p} does not have -x bit, strange!\n");
+      my $ret = system("'$def' $arg >/dev/null 2>&1" ); # we are on Unix
+      if ($ret == 0) {
+        $::progs{$p} = $def;
+        debug("Using shipped $def for $p (tested).\n");
+        return(1);
       } else {
-        # check again for executability
-        if ($arg ne "notest") {
-          my $ret = system("$::progs{$p} $arg > /dev/null 2>&1");
-          if ($ret == 0) {
-            # ok, the copy works
-            debug("Using copied $::progs{$p} for $p (tested).\n");
-          } else {
-            # even the copied prog is not executable, strange
-            $test_fallback = 1;
-            ddebug("Copied $p $::progs{$p} has x bit but not executable?!\n");
-          }
-        } else {
-          debug("Using copied $::progs{$p} for $p (not tested).\n");
-        }
+        ddebug("Shipped $def has -x but cannot be executed, "
+               . "trying tmp copy.\n");
       }
     }
-  } else {
-    # hope that we can find in the global PATH
-    $test_fallback = 1;
-  }
-  if ($test_fallback) {
-    # all our playing around and copying did not succeed, try PATH.
-    $::progs{$p} = $p;
-    if ($arg ne "notest") {
-      my $ret = system("$p $arg >/dev/null 2>&1");
+    # we are still here
+    # out of some reasons we couldn't execute the shipped program
+    # try to copy it to a temp directory and make it executable
+    #
+    # create tmp dir only when necessary
+    $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp);
+    # probably we are running from uncompressed media and want to copy it to
+    # some temporary location
+    copy($def, $tmp);
+    my $bn = basename($def);
+    my $tmpprog = "$tmp/$bn";
+    chmod(0755,$tmpprog);
+    # we do not check the return value of chmod, but check whether
+    # the -x bit is now set, the only thing that counts
+    if (! -x $tmpprog) {
+      # hmm, something is going really bad, not even the copy is
+      # executable. Fall back to normal path element
+      ddebug("Copied $p $tmpprog does not have -x bit, strange!\n");
+      return(0);
+    } else {
+      # check again for executability
+      my $ret = system("$tmpprog $arg > /dev/null 2>&1");
       if ($ret == 0) {
-        debug("Using system $p (tested).\n");
+        # ok, the copy works
+        debug("Using copied $tmpprog for $p (tested).\n");
+        $::progs{$p} = $tmpprog;
+        return(1);
       } else {
-        if ($donotwarn) {
-          debug("$0: initialization of $p failed but ignored!\n");
-        } else {
-          tlwarn("$0: Initialization failed (in setup_unix_one):\n");
-          tlwarn("$0: could not find a usable $p.\n");
-          tlwarn("$0: Please install $p and try again.\n");
-        }
-        return 0;
+        # even the copied prog is not executable, strange
+        ddebug("Copied $p $tmpprog has x bit but not executable?!\n");
+        return(0);
       }
-    } else {
-      debug ("Using system $p (not tested).\n");
     }
+  } else {
+    # default program is not readable
+    return(0);
   }
-  return 1;
 }