From f3d1051cb6e1efc35786eec5bc6d5324d6924a8d Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sat, 1 Nov 2008 17:15:20 +0000 Subject: tlmgr.pl: check for perldoc being present, instead of just for windows. TLUtils.pm (program_exists): delete, it is not used anywhere that I can see and the documentation was wrong. (which): reformat. git-svn-id: svn://tug.org/texlive/trunk@11151 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 43 +++++++++++++------------ Master/tlpkg/TeXLive/TLUtils.pm | 59 ++++++++++++++--------------------- 2 files changed, 46 insertions(+), 56 deletions(-) (limited to 'Master') diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 0a8fc5de08d..d5c7c7f1f33 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -105,22 +105,6 @@ GetOptions("location=s" => \$opt_location, my $action = shift; -# -# besides doing normal logging if -logfile is specified, we try to log -# package related actions (install, remove, update) to -# the package-log file TEXMFSYSVAR/web2c/tlmgr.log -my $packagelogged = 0; # how many msgs we logged. -my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`; -chomp($texmfsysvar); -my $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log"; -# -# Try to open the packagelog file, but do NOT die when that does not work -if (!open(PACKAGELOG, ">>$packagelogfile")) { - debug("Cannot open package log file $packagelogfile for appending\n"); - debug("Will not log package installation/removal/update for that run\n"); - $packagelogfile = ""; -} - if (!defined($action) && $opt_gui) { $action = "gui"; } @@ -146,10 +130,29 @@ if (!defined($action) && !$opt_help) { die "$0: missing action; try --help if you need it.\n"; } -if ($^O =~ /^MSWin(32|64)$/i) { - pod2usage(-exitstatus => 0, -verbose => 2, -noperldoc => 1) if $opt_help; -} else { - pod2usage(-exitstatus => 0, -verbose => 2) if $opt_help; +# Often Windows will not have perldoc, but some Unix-based +# installations may lack it also. We want to use it if we have it, to +# get ASCII emphasis. +if ($opt_help) { + if (TeXLive::TLUtils::which("perldoc")) { + pod2usage(-exitstatus => 0, -verbose => 2); + } else { + pod2usage(-exitstatus => 0, -verbose => 2, -noperldoc => 1); + } +} + +# besides doing normal logging if -logfile is specified, we try to log +# package related actions (install, remove, update) to +# the package-log file TEXMFSYSVAR/web2c/tlmgr.log +my $packagelogged = 0; # how many msgs we logged +chomp (my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`); +my $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log"; +# +# Try to open the packagelog file, but do NOT die when that does not work +if (!open(PACKAGELOG, ">>$packagelogfile")) { + debug("Cannot open package log file $packagelogfile for appending\n"); + debug("Will not log package installation/removal/update for that run\n"); + $packagelogfile = ""; } my $loadmediasrcerror = "Cannot load TeX Live database from "; diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index e4ac72ff563..b908b946c0b 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -29,7 +29,6 @@ C -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::getenv($string); TeXLive::TLUtils::which($string); - TeXLive::TLUtils::program_exists($program); TeXLive::TLUtils::get_system_tmpdir; =head2 File Utilities @@ -82,7 +81,6 @@ BEGIN { &unix &getenv &which - &program_exists &get_system_tmpdir &dirname &basename @@ -311,42 +309,31 @@ environment variable, an extension might aleady be present. =cut sub which { - my $prog=shift; - my @PATH; - my $PATH=getenv('PATH'); - if (&win32) { - my @PATHEXT=split ';', getenv('PATHEXT'); - push @PATHEXT, ''; # if argument contains an extension - @PATH=split ';', $PATH; - for my $dir (@PATH) { - for my $ext (@PATHEXT) { - if (-f "$dir/$prog$ext") { - return "$dir/$prog$ext"; - } - } - } - } else { - @PATH=split ':', $PATH; - for my $dir (@PATH) { - if (-x "$dir/$prog") { - return "$dir/$prog"; - } - } - } - return 0; -} - -=pod - -=item C + my ($prog) = @_; + my @PATH; + my $PATH = getenv('PATH'); -Return C<1> if C<$program> is in C and C<0> otherwise. - -=cut + if (&win32) { + my @PATHEXT = split (';', getenv('PATHEXT')); + push (@PATHEXT, ''); # in case argument contains an extension + @PATH = split (';', $PATH); + for my $dir (@PATH) { + for my $ext (@PATHEXT) { + if (-f "$dir/$prog$ext") { + return "$dir/$prog$ext"; + } + } + } -sub program_exists { - my $program=shift; - return (&which ("$program"))? 0:1; + } else { # not windows + @PATH = split (':', $PATH); + for my $dir (@PATH) { + if (-x "$dir/$prog") { + return "$dir/$prog"; + } + } + } + return 0; } =pod -- cgit v1.2.3