diff options
author | Reinhard Kotucha <reinhard.kotucha@web.de> | 2008-10-19 14:34:28 +0000 |
---|---|---|
committer | Reinhard Kotucha <reinhard.kotucha@web.de> | 2008-10-19 14:34:28 +0000 |
commit | 1964f534c824feb2dd6708aec9c5c066c376bc4b (patch) | |
tree | 40d566d7804e5f1d376a33655a7c3cf9ef2ef7d6 /Master/texmf/scripts | |
parent | 62d62445934ecbf468dd87a414da8f5238dfe959 (diff) |
getnonfreefonts.pl: --http added, Windows related bug fixed.
git-svn-id: svn://tug.org/texlive/trunk@11013 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf/scripts')
-rwxr-xr-x | Master/texmf/scripts/texlive/getnonfreefonts.pl | 95 |
1 files changed, 70 insertions, 25 deletions
diff --git a/Master/texmf/scripts/texlive/getnonfreefonts.pl b/Master/texmf/scripts/texlive/getnonfreefonts.pl index 457ce1e25a6..99530a25111 100755 --- a/Master/texmf/scripts/texlive/getnonfreefonts.pl +++ b/Master/texmf/scripts/texlive/getnonfreefonts.pl @@ -13,11 +13,10 @@ my $TL_version='2008'; -my $getfont_url="ftp://tug.org/tex/getnonfreefonts/getfont$TL_version"; - use File::Copy; use Getopt::Long; $Getopt::Long::autoabbrev=0; +Getopt::Long::Configure ("bundling"); $opt_lsfonts=0; $opt_force=0; @@ -26,7 +25,8 @@ sub usage { print <<'EOF'; Usage: getnonfreefonts[-sys] [-a|--all] [-d|--debug] [-f|--force] - [-l|--lsfonts] [-v|--verbose] [--version] [font1] [font2] ... + [-l|--lsfonts] [-v|--verbose] [--version] [-H|--http] + [font1] [font2] ... getnonfreefonts installs fonts in $TEXMFHOME. getnonfreefonts-sys installs fonts in $TEXMFLOCAL. @@ -44,6 +44,8 @@ Usage: -v|--verbose Be more verbose. + -H|--http Use http instead of ftp (see manual). + --version Print version number. EOF @@ -57,6 +59,7 @@ GetOptions "debug|d", "force|f", "help|h", + "http|H", "lsfonts|l", "verbose|v", "version", @@ -80,6 +83,15 @@ if ($opt_help or !@ARGS) { } +sub win32 { + if ($^O=~/^MSWin(32|64)/i) { + return 1; + } else { + return 0; + } +} + + sub message { my $message=shift; if ($message=~/^\[/) { @@ -97,14 +109,29 @@ sub debug_msg { } } + sub which { my $prog=shift; my @PATH; my $PATH=$ENV{'PATH'}; - @PATH=split ':', $PATH; - for my $dir (@PATH) { - if (-x "$dir/$prog") { - return "$dir/$prog"; + if (&win32) { + my @PATHEXT=split ';', $ENV{'PATHEXT'}; + push @PATHEXT, ''; # if argument contains an extension + @PATH=split ';', $PATH; + for my $dir (@PATH) { + $dir=~s/\\/\//g; + 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; @@ -114,7 +141,7 @@ sub which { sub expand_var { my $var=shift; - if ($^O=~/^MSWin(32|64)/i) { + if (win32) { open KPSEWHICH, 'kpsewhich --expand-var=$' . "$var |"; } else { open KPSEWHICH, 'kpsewhich --expand-var=\$' . "$var |"; @@ -155,10 +182,12 @@ debug_msg "Internal variable SYSTMP set to '$SYSTMP'"; # allowed. Perl always needs forward slashes. # We convert backslashes to forward slashes on Windows. -$SYSTMP=~s/\\/\//g if ($^O=~/^MSWin(32|64)/i); +if (win32) { + $SYSTMP=~s/\\/\//g; + debug_msg "Internal variable SYSTMP converted to '$SYSTMP'"; +} -debug_msg "Internal variable SYSTMP converted to '$SYSTMP'"; sub check_tmpdir{ die "! ERROR: The temporary directory '$SYSTMP' doesn't exist.\n" @@ -168,22 +197,16 @@ die "! ERROR: The temporary directory '$SYSTMP' is not writable.\n" unless (-w "$SYSTMP"); } -# Determine INSTALLROOT. if ($opt_debug) { - my @path=split ':', $ENV{PATH}; - for my $dir (@path) { - debug_msg "Search for kpsewhich in '$dir'"; - opendir DIR, "$dir"; - my @kpsewichs=grep /^kpsewhich/, readdir DIR; - closedir DIR; - for (@kpsewichs) { - debug_msg "Found $dir/$_" if /^kpsewhich/; - } - } + debug_msg "Search for kpsewhich in PATH"; + my $kpsewhich=which "kpsewhich"; + debug_msg "Found $kpsewhich"; } +# Determine INSTALLROOT. + $INSTALLROOTNAME=($sys)? 'TEXMFLOCAL':'TEXMFHOME'; $INSTALLROOT=expand_var "$INSTALLROOTNAME"; @@ -192,7 +215,7 @@ $INSTALLROOT=expand_var "$INSTALLROOTNAME"; debug_msg "INSTALLROOT='$INSTALLROOT'"; -$INSTALLROOT=~s/\\/\//g if ($^O=~/^MSWin(32|64)/i); +$INSTALLROOT=~s/\\/\//g if (win32); debug_msg "Internal variable INSTALLROOT converted to '$INSTALLROOT'"; @@ -255,7 +278,7 @@ my @signals_UNIX=qw(QUIT BUS PIPE); my @signals_Win32=qw(BREAK); -if ($^O=~/^MSWin(32|64)$/i) { +if (win32) { @signals=(@common_signals, @signals_Win32); } else { @signals=(@common_signals, @signals_UNIX); @@ -269,12 +292,33 @@ foreach my $signal (@signals) { # Download the script from tug.org. +my $getfont_url; + +if ($opt_http) { + $getfont_url="http://tug.org/~kotucha/getnonfreefonts/getfont$TL_version"; +} else { + $getfont_url="ftp://tug.org/tex/getnonfreefonts/getfont$TL_version"; +} + my $has_wget=0; -if ($^O=~/^MSWin(32|64)$/i) { +if (win32) { $has_wget=1; ## shipped with TL. } elsif (which "wget") { - $has_wget=1; + $has_wget=1; ## wget is in PATH. +} + + +if ($opt_debug) { + my @PATH; + if (win32) { + @PATH=split ';', $ENV{'PATH'}; + } else { + @PATH=split ':', $ENV{'PATH'}; + } + foreach my $dir (@PATH) { + debug_msg "PATH: '$dir'"; + } } debug_msg "No wget binary found on your system, trying curl" unless ($has_wget); @@ -299,6 +343,7 @@ push @getfont, '--debug' if $opt_debug; push @getfont, '--verbose' if $opt_verbose; push @getfont, '--sys' if $sys; push @getfont, '--all' if $opt_all; +push @getfont, '--http' if $opt_http; push @getfont, '--use_curl' unless ($has_wget); push @getfont, @allpackages; |