diff options
author | Reinhard Kotucha <reinhard.kotucha@web.de> | 2007-09-09 21:51:52 +0000 |
---|---|---|
committer | Reinhard Kotucha <reinhard.kotucha@web.de> | 2007-09-09 21:51:52 +0000 |
commit | d112d1b7efe434750ca255fe2f0e191e8ba8f2f7 (patch) | |
tree | 665c40bf54cf062bb5d67a87d20b479a31a458b0 /Master | |
parent | 796864bbfd9ddb511d457c7c268aeea4550af45c (diff) |
TLUtils.pm: new functions
Perl-API.txt: updated
git-svn-id: svn://tug.org/texlive/trunk@4926 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 193 | ||||
-rw-r--r-- | Master/tlpkg/doc/Perl-API.txt | 13 |
2 files changed, 179 insertions, 27 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index f30b2410f1f..e0bbe8f48e6 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -24,15 +24,21 @@ C<TeXLive::TLUtils> -- Utilities used in the TeX Live Infrastructure Modules TeXLive::TLUtils::push_uniq(\@list, @items); TeXLive::TLUtils::member($item, @list); TeXLive::TLUtils::debug($string); + TeXLive::TLUtils::initialze_installer; TeXLive::TLUtils::getenv($string); TeXLive::TLUtils::which($string); - TeXLive::TLUtils::initialze_installer; TeXLive::TLUtils::media; TeXLive::TLUtils::platform; + TeXLive::TLUtils::platform_desc($platform); TeXLive::TLUtils::win32; + TeXLive::TLUtils::unix; TeXLive::TLUtils::program_exists($program); - TeXLive::TLUtils::binaries_available_from_disk($platform); - TeXLive::TLUtils::binaries_available_from_net($platform); + TeXLive::TLUtils::binaries_available_from_disk; + TeXLive::TLUtils::binaries_available_from_net; + TeXLive::TLUtils::get_system_tmpdir; + TeXLive::TLUtils::mkdirhier($path); + TeXLive::TLUtils::make_var_skeleton($path); + TeXLive::TLUtils::make_local_skeleton($path); =head1 DESCRIPTION @@ -51,15 +57,21 @@ BEGIN { &push_uniq &member &debug + &initialize_installer &getenv &which &media &platform - &initialize_installer + &platform_desc &win32 + &unix &program_exists &binaries_available_from_disk &binaries_available_from_net + &get_system_tmpdir + &mkdirhier + &make_var_skeleton + &sub make_local_skeleton ); } @@ -127,6 +139,18 @@ sub member { return 0; } +=pod + +=item C<debug($string)> + +The C<debug> function echos the argument string to STDERR in case that +the global varialbe C<opt_debug> is set. + +=cut + +sub debug { + print STDERR @_ if ($::opt_debug); +} =pod @@ -148,22 +172,6 @@ sub initialize_installer { &platform; } - -=pod - -=item C<debug($string)> - -The C<debug> function echos the argument string to STDERR in case that -the global varialbe C<opt_debug> is set. - -=cut - -sub debug { - print STDERR @_ if ($::opt_debug); -} - -=pod - =item C<getenv($string)> Get an environment variable. It is assumed that the environment @@ -177,7 +185,7 @@ environment variable is not set. sub getenv { my $envvar=shift; my $var=$ENV{"$envvar"}; - return 0 unless (defined "$var"); + return 0 unless (defined $var); if (&win32) { $var=~s@\\@/@g; # change \ -> / (required by Perl) } @@ -224,7 +232,6 @@ sub which { =pod - =item C<media> Return media type. Either C<CD>, C<DVD>, or C<NET>. @@ -263,7 +270,7 @@ C<s/i.86/i386/>. For OS we need a list because we probably have something like C<linux-gnu> but we need C<linux>. This list might/should contain OSs which are not currently supported. The list currently supports all -platforms supported by TeXLive 2007 plus Cygwin. +platforms supported by TeX Live 2007 plus Cygwin. If a particular platform is not found in this list we use the regexp C</.*-(.*$)/> as a last resort and hope it provides something useful. @@ -302,6 +309,49 @@ sub platform { return $::_platform_; } +=pod + +=item C<platform_desc($platform)> + +Return a string which describes a particular platform. Same as in TeX +Live 2007 but NetBSD added. + +=cut + +sub platform_desc { + my $platform=shift; + + my %platform_name=( + 'alpha-linux' => 'DEC Alpha with GNU/Linux', + 'alphaev5-osf' => 'DEC Alphaev5 OSF', + 'hppa-hpux' => 'HP-UX', + 'i386-cygwin' => 'Intel x86 with Cygwin', + 'i386-darwin' => 'Intel x86 with MacOSX/Darwin', + 'i386-freebsd' => 'Intel x86 with FreeBSD', + 'i386-openbsd' => 'Intel x86 with OpenBSD', + 'i386-netbsd' => 'Intel x86 with NetBSD', + 'i386-linux' => 'Intel x86 with GNU/Linux', + 'i386-solaris' => 'Intel x86 with Sun Solaris', + 'mips-irix' => 'SGI IRIX', + 'powerpc-aix' => 'PowerPC with AIX', + 'powerpc-darwin' => 'PowerPC with MacOSX/Darwin', + 'powerpc-linux' => 'PowerPC with GNU/Linux', + 'sparc-linux' => 'Sparc with GNU/Linux', + 'sparc-solaris' => 'Sparc with Solaris', + 'win32' => 'Windows', + 'x86_64-linux' => 'Intel x86_64 with GNU/Linux' + ); + + if (defined $platform_name{$platform}) { + return "$platform_name{$platform}"; + } else { + my $CPU; + my $OS; + ($CPU, $OS)=split '-', "$platform"; + return "$CPU with " . ucfirst "$OS"; + } +} + =pod =item C<win32> @@ -314,6 +364,16 @@ sub win32 { return (&platform eq "win32")? 1:0; } +=item C<unix> + +Return C<1> if platform is UNIX and C<0> otherwise. + +=cut + +sub unix { + return (&platform eq "win32")? 0:1; +} + =pod =item C<program_exists($program)> @@ -387,8 +447,93 @@ sub binaries_available_from_net { return @platforms; } -1; +=pod + +=item C<get_system_tmpdir> + +Evaluate the environment variables C<TMPDIR>, C<TMP>, and C<TEMP> in +order to find the system temporary directory. + +=cut + +sub get_system_tmpdir { + my $systmp=0; + $systmp||=getenv 'TMPDIR'; + $systmp||=getenv 'TMP'; + $systmp||=getenv 'TEMP'; + $systmp||='/tmp'; + return "$systmp"; +} + +=pod + +=item C<mkdirhier($path)> + +The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>. + +=cut + +sub mkdirhier { + my $tree=shift; + my $subdir; + @dirs=split /\//, $tree; + + foreach $dir (@dirs) { + $subdir .= ("$dir" . "/"); + unless (-d $subdir) { + mkdir "$subdir", 0755 || die "Can't mkdir $subdir"; + } + } +} + +=pod +=item C<make_var_skeleton($prefix)> + +Generate a skeleton of empty directories in the C<TEXMFSYSVAR> tree. + +=cut + +sub make_var_skeleton { + my $prefix=shift; + + mkdirhier "$prefix/tex/generic/config"; + mkdirhier "$prefix/dvipdfm/config"; + mkdirhier "$prefix/tex/plain/config"; + mkdirhier "$prefix/dvips/config"; + mkdirhier "$prefix/fonts/map/dvipdfm/updmap"; + mkdirhier "$prefix/fonts/map/dvips/updmap"; + mkdirhier "$prefix/fonts/map/pdftex/updmap"; + mkdirhier "$prefix/web2c"; + mkdirhier "$prefix/xdvi"; + mkdirhier "$prefix/tex/context/config"; +} + +=pod + +=item C<make_local_skeleton($prefix)> + +Generate a skeleton of empty directories in the C<TEXMFLOCAL> tree. + +=cut + +sub make_local_skeleton { + my $prefix=shift; + + mkdirhier "$prefix/tex/latex/local"; + mkdirhier "$prefix/tex/plain/local"; + mkdirhier "$prefix/dvips/local"; + mkdirhier "$prefix/bibtex/bib/local"; + mkdirhier "$prefix/bibtex/bst/local"; + mkdirhier "$prefix/fonts/tfm/local"; + mkdirhier "$prefix/fonts/vf/local"; + mkdirhier "$prefix/fonts/source/local"; + mkdirhier "$prefix/fonts/type1/local"; + mkdirhier "$prefix/metapost/local"; + mkdirhier "$prefix/web2c"; +} + +1; =pod diff --git a/Master/tlpkg/doc/Perl-API.txt b/Master/tlpkg/doc/Perl-API.txt index d0557816fb3..e4ea303ef0c 100644 --- a/Master/tlpkg/doc/Perl-API.txt +++ b/Master/tlpkg/doc/Perl-API.txt @@ -267,14 +267,21 @@ Package TeXLive::TLUtils exported functions: sort_uniq(@list) push_uniq(\@list,@list) - dirname($file) - basename($file) + member($item, @list) + debug($string) +# dirname($file) +# basename($file) + initialze_installer getenv($string) which($string) - initialze_installer media platform win32 + unix program_exists($program) binaries_available_from_disk($platform) binaries_available_from_net($platform) + get_system_tmpdir; + mkdirhier($path); + make_var_skeleton($path); + make_local_skeleton($path); |