summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorReinhard Kotucha <reinhard.kotucha@web.de>2007-09-21 21:13:00 +0000
committerReinhard Kotucha <reinhard.kotucha@web.de>2007-09-21 21:13:00 +0000
commit55e469a40abbd1a4407556cfab0a3ef12a18ede8 (patch)
tree638b6f9876d8964e342d9cbebe28c170708e1d6d
parent5a188bc881c4f3772fbeb986ee6f41ccb8864576 (diff)
TLUtils.pm: File Utilities added.
Perl-API.txt: updated. git-svn-id: svn://tug.org/texlive/trunk@4992 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm647
-rw-r--r--Master/tlpkg/doc/Perl-API.txt43
2 files changed, 434 insertions, 256 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index e0bbe8f48e6..eb2e87e934e 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -1,14 +1,16 @@
# $Id$
# TeXLive::TLUtils.pm
-# common functions for TeX Live Infrastructure
+# Common Functions for TeX Live Infrastructure
#
# Copyright 2007 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
-#
-# ideas from Fabrice Popineau's FileUtils.pm.
+
package TeXLive::TLUtils;
+use Fcntl; # required by copy()
+
+#use File::Basename;
=pod
@@ -20,31 +22,48 @@ C<TeXLive::TLUtils> -- Utilities used in the TeX Live Infrastructure Modules
use TeXLive::TLUtils;
- TeXLive::TLUtils::sort_uniq(@list);
- 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::media;
+=head2 Platform Detection
+
TeXLive::TLUtils::platform;
TeXLive::TLUtils::platform_desc($platform);
TeXLive::TLUtils::win32;
TeXLive::TLUtils::unix;
+
+=head2 System Tools
+
+ TeXLive::TLUtils::getenv($string);
+ TeXLive::TLUtils::which($string);
TeXLive::TLUtils::program_exists($program);
- TeXLive::TLUtils::binaries_available_from_disk;
- TeXLive::TLUtils::binaries_available_from_net;
TeXLive::TLUtils::get_system_tmpdir;
+
+=head2 File Utulities
+
+ TeXLive::TLUtils::dirname($path);
+ TeXLive::TLUtils::basename($path);
+ TeXLive::TLUtils::dirname_and_basename($path);
TeXLive::TLUtils::mkdirhier($path);
+ TeXLive::TLUtils::copy($file, $target_dir);
+
+=head2 Installer Functions
+
+ TeXLive::TLUtils::media;
+ TeXLive::TLUtils::initialze_installer;
+ TeXLive::TLUtils::binaries_available_from_disk;
+ TeXLive::TLUtils::binaries_available_from_net;
TeXLive::TLUtils::make_var_skeleton($path);
TeXLive::TLUtils::make_local_skeleton($path);
+=head2 Miscellaneous
+
+ TeXLive::TLUtils::sort_uniq(@list);
+ TeXLive::TLUtils::push_uniq(\@list, @items);
+ TeXLive::TLUtils::member($item, @list);
+ TeXLive::TLUtils::debug($string);
+
=head1 DESCRIPTION
=cut
-use File::Basename;
BEGIN {
use Exporter ();
@@ -53,124 +72,164 @@ BEGIN {
use vars qw( @ISA @EXPORT_OK );
@ISA = qw(Exporter);
@EXPORT_OK = qw(
- &sort_uniq
- &push_uniq
- &member
- &debug
- &initialize_installer
- &getenv
- &which
- &media
&platform
&platform_desc
&win32
&unix
+ &getenv
+ &which
&program_exists
- &binaries_available_from_disk
- &binaries_available_from_net
&get_system_tmpdir
+ &dirname
+ &basename
+ &dirname_and_basename
&mkdirhier
+ &copy
+ &media
+ &initialize_installer
+ &binaries_available_from_disk
+ &binaries_available_from_net
&make_var_skeleton
&sub make_local_skeleton
+ &sort_uniq
+ &push_uniq
+ &member
+ &debug
);
}
=pod
+=head2 Platform Detection
+
=over 6
-=item C<sort_uniq(@list)>
+=item C<platform>
-The C<sort_uniq> function sorts the given array and throws away multiple
-occurrences of elements. It returns a sorted and unified array.
+If the directory C</usr/bin> doesn't exist we know that we're on
+Windows and we set the global variable C<$::_platform_> to C<win32>.
+If it exists we call C<config.guess>. The output of C<config.guess>
+is filtered as described below.
+
+CPU type is determined by a regexp. And it's necessary to
+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 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.
+
+The result is stored in a global variable C<$::_platform_>. If you call
+C<platform> repeatedly, only the first call of C<platform> will access
+the HD/CD/DVD.
=cut
-sub sort_uniq {
- my (@l) = @_;
- my ($e, $f, @r);
- $f = "";
- @l = sort(@l);
- foreach $e (@l) {
- if ($e ne $f) {
- $f = $e;
- push @r, $e;
+sub platform {
+ my @OSs=qw(aix cygwin darwin freebsd hpux irix linux netbsd openbsd
+ solaris);
+
+ unless (defined $::_platform_) {
+ if (-d "/usr/bin") {
+ my $CPU; # CPU type as reported by config.guess.
+ my $OS; # O/S type as reported by config.guess.
+ my $guessed_platform=`$::_installerdir_/config.guess`;
+ chomp $guessed_platform;
+ ($CPU=$guessed_platform)=~s/(.*?)-.*/$1/;
+ foreach my $os (@OSs) {
+ $OS=$os if $guessed_platform=~/$os/;
+ }
+ if ($OS=~/^i.86$/) {
+ $OS=~s/i.86/i386/;
+ }
+ if (length "$OS" < 0) {
+ ($OS=$guessed_platform)=~s/.*-(.*)/$1/;
+ }
+ $::_platform_="$CPU-$OS";
+ } else {
+ $::_platform_="win32";
}
}
- return @r;
+ return $::_platform_;
}
=pod
-=item C<push_uniq(\@list, @items)>
+=item C<platform_desc($platform)>
-The C<push_uniq> function pushes the last elements on the list referenced
-by the first argument.
+Return a string which describes a particular platform. Same as in TeX
+Live 2007 but NetBSD added.
=cut
-sub push_uniq {
- # can't we use $l as a reference, and then use my? later ...
- local (*l, @le) = @_;
- foreach my $e (@le) {
- if (! &member($e, @l)) {
- push @l, $e;
- }
+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
+=pod
-=item C<member($item, @list)>
+=item C<win32>
-The C<member> function returns true if the the first argument is contained
-in the list of the remaining arguments.
+Return C<1> if platform is Windows and C<0> otherwise.
=cut
-sub member {
- my ($e, @l) = @_;
- my ($f);
- foreach $f (@l) {
- if ($e eq $f) {
- return 1;
- }
- }
- return 0;
+sub win32 {
+ return (&platform eq "win32")? 1:0;
}
=pod
-=item C<debug($string)>
+=item C<unix>
-The C<debug> function echos the argument string to STDERR in case that
-the global varialbe C<opt_debug> is set.
+Return C<1> if platform is UNIX and C<0> otherwise.
=cut
-sub debug {
- print STDERR @_ if ($::opt_debug);
+sub unix {
+ return (&platform eq "win32")? 0:1;
}
=pod
-=item C<initialize_installer>
-
-The function C<initialize_installer> first determines the directory in
-which tl-install.pl resides (which is C<`dirname $0`> on UNIX). Then
-it calls C<media> and C<platform> in order to set the variables
-C<$::_media_> and C<$::_platform_>.
-
-Repeatedly calls to C<media> or C<platform> do not access the CD/DVD
-again.
+=back
-=cut
+=head2 System Tools
-sub initialize_installer {
- ($::_installerdir_=$0)=~s/(.*)\/.*$/$1/;
- &media;
- &platform;
-}
+=over 6
=item C<getenv($string)>
@@ -230,161 +289,230 @@ sub which {
return 0;
}
-=pod
+=pod
-=item C<media>
+=item C<program_exists($program)>
-Return media type. Either C<CD>, C<DVD>, or C<NET>.
+Return C<1> if C<$program> is in C<PATH> and C<0> otherwise.
-The result is stored in a global variable C<$::_media_>. If you call
-C<media> repeatedly, only the first call of C<media> will access the
-CD/DVD.
+=cut
+
+sub program_exists {
+ my $program=shift;
+ return (&which ("$program"))? 0: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 media {
- unless (defined $::_media_) {
- if (-d "$::_installerdir_/archive") {
- $::_media_="CD";
- } elsif (-d "$::_installerdir_/texmf/web2c") {
- $::_media_="DVD";
- } else {
- $::_media_="NET";
- }
- }
- return $::_media_;
+sub get_system_tmpdir {
+ my $systmp=0;
+ $systmp||=getenv 'TMPDIR';
+ $systmp||=getenv 'TMP';
+ $systmp||=getenv 'TEMP';
+ $systmp||='/tmp';
+ return "$systmp";
}
=pod
-=item C<platform>
+=back
-If the directory C</usr/bin> doesn't exist we know that we're on
-Windows and we set the global variable C<$::_platform_> to C<win32>.
-If it exists we call C<config.guess>. The output of C<config.guess>
-is filtered as described below.
+=head2 File Utulities
-CPU type is determined by a regexp. And it's necessary to
-C<s/i.86/i386/>.
+=over 6
-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 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.
+=item C<dirname($path)>
-The result is stored in a global variable C<$::_platform_>. If you call
-C<platform> repeatedly, only the first call of C<platform> will access
-the HD/CD/DVD.
+Return C<$path> with its trailing C</component> removed.
=cut
-sub platform {
- my @OSs=qw(aix cygwin darwin freebsd hpux irix linux netbsd openbsd
- solaris);
+sub dirname {
+ $_[0]=~/(.*)\/.*/;
+ return "$1";
+}
- unless (defined $::_platform_) {
- if (-d "/usr/bin") {
- my $CPU; # CPU type as reported by config.guess.
- my $OS; # O/S type as reported by config.guess.
- my $guessed_platform=`$::_installerdir_/config.guess`;
- chomp $guessed_platform;
- ($CPU=$guessed_platform)=~s/(.*?)-.*/$1/;
- foreach my $os (@OSs) {
- $OS=$os if $guessed_platform=~/$os/;
- }
- if ($OS=~/^i.86$/) {
- $OS=~s/i.86/i386/;
- }
- if (length "$OS" < 0) {
- ($OS=$guessed_platform)=~s/.*-(.*)/$1/;
+=item C<basename($path)>
+
+Return C<$path> with any leading directory components removed.
+
+=cut
+
+sub basename {
+ $_[0]=~/.*\/(.*)/;
+ return "$1";
+}
+
+=item C<dirname_and_basename($path)>
+
+Return C<dirname> and C<basename>. Example:
+
+ ($dir, $file)=dirname_and_basename($path);
+
+=cut
+
+sub dirname_and_basename {
+ $_[0]=~/(.*)\/(.*)/;
+ return ("$1", "$2");
+}
+
+=pod
+
+=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.
+
+=cut
+
+sub mkdirhier {
+ my $tree=shift;
+ my $mode=shift;
+ my $subdir;
+
+ @dirs=split /\//, $tree;
+ foreach $dir (@dirs) {
+ $subdir .= ("$dir" . "/");
+ unless (-d $subdir) {
+ if (defined $mode) {
+ mkdir ("$subdir", $mode) or die "Can't mkdir '$subdir': $!.\n";
+ } else {
+ mkdir "$subdir" or die "Can't mkdir '$subdir': $!.\n";
}
- $::_platform_="$CPU-$OS";
- } else {
- $::_platform_="win32";
}
}
- return $::_platform_;
}
=pod
-=item C<platform_desc($platform)>
+=item C<copy($file, $target_dir)>
-Return a string which describes a particular platform. Same as in TeX
-Live 2007 but NetBSD added.
+Copy file C<$file> to directory C<$target_dir>. No external programs
+are involved. Since we need C<sysopen()>, the Perl module C<Fcntl.pm>
+is required. The time stamps are preserved and symlinks are created
+on UNIX systems. On Windows, C<(-l $file)> will certainly never
+return 'C<true>' and symlinks will be copied as regular files.
+
+C<copy> invokes C<mkdirhier> if target directories do not exist.
+These directories are created with mode C<0755>. Because the files
+are copied from a read-only media with all write permissions removed,
+the write flag is set for the current user, quite similar to
+
+ chmod u+w $target_dir/`basename $file`
=cut
-sub platform_desc {
- my $platform=shift;
+sub copy {
+ my $infile=shift;
+ my $destdir=shift;
+ my $outfile;
+ my @stat;
+ my $mode;
+ my $buffer;
+ my $offset;
+ my $filename;
+ my $dirmode=0755;
+ my $blocksize=2048;
+
+ @stat=lstat "$infile";
+ $mode=$stat[2];
+
+ # set write bit for user if necessary.
+ $mode+=128 if ($mode%256<128);
- 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'
- );
+ mkdirhier ("$destdir", $dirmode) unless -d "$destdir";
- if (defined $platform_name{$platform}) {
- return "$platform_name{$platform}";
+ $filename=basename "$infile";
+ $outfile="$destdir/$filename";
+
+# print "copy $infile => $outfile\n";
+# print "$infile\n";
+
+ if (-l "$infile") {
+ symlink readlink "$infile", "$destdir/$filename";
} else {
- my $CPU;
- my $OS;
- ($CPU, $OS)=split '-', "$platform";
- return "$CPU with " . ucfirst "$OS";
+ sysopen IN, "$infile", O_RDONLY
+ or die "Can't open '$infile': $!\n";
+ binmode IN;
+
+ sysopen OUT, "$outfile", (O_CREAT|O_WRONLY) , $mode
+ or die "Can't open '$outfile': $!\n";
+ binmode OUT;
+
+ while ($read=sysread IN, $buffer, $blocksize) {
+ die "system read error: $!\n" unless defined $read;
+ $offset=0;
+ while ($read) {
+ $written=syswrite OUT, $buffer, $read, $offset;
+ die "system write error: $!\n" unless defined $written;
+ $read-=$written;
+ $offset+=$written;
+ }
+ }
+ close OUT;
+ close IN;
+ utime $stat[8], $stat[9], "$outfile";
}
}
-=pod
+=pod
-=item C<win32>
+=back
-Return C<1> if platform is Windows and C<0> otherwise.
+=head2 Installer Functions
-=cut
+=over 6
-sub win32 {
- return (&platform eq "win32")? 1:0;
-}
-=item C<unix>
+=item C<media>
-Return C<1> if platform is UNIX and C<0> otherwise.
+Return media type. Either C<CD>, C<DVD>, or C<NET>.
+
+The result is stored in a global variable C<$::_media_>. If you call
+C<media> repeatedly, only the first call of C<media> will access the
+CD/DVD.
=cut
-sub unix {
- return (&platform eq "win32")? 0:1;
+sub media {
+ unless (defined $::_media_) {
+ if (-d "$::_installerdir_/archive") {
+ $::_media_="CD";
+ } elsif (-d "$::_installerdir_/texmf/web2c") {
+ $::_media_="DVD";
+ } else {
+ $::_media_="NET";
+ }
+ }
+ return $::_media_;
}
-=pod
+=pod
-=item C<program_exists($program)>
+=item C<initialize_installer>
-Return C<1> if C<$program> is in C<PATH> and C<0> otherwise.
+The function C<initialize_installer> first determines the directory in
+which tl-install.pl resides (which is C<`dirname $0`> on UNIX). Then
+it calls C<media> and C<platform> in order to set the variables
+C<$::_media_> and C<$::_platform_>.
+
+Repeatedly calls to C<media> or C<platform> do not access the CD/DVD
+again.
=cut
-sub program_exists {
- my $program=shift;
- return (&which ("$program"))? 0:1;
+sub initialize_installer {
+ ($::_installerdir_=$0)=~s/(.*)\/.*$/$1/;
+ &media;
+ &platform;
}
=pod
@@ -449,91 +577,136 @@ sub binaries_available_from_net {
=pod
-=item C<get_system_tmpdir>
+=item C<make_var_skeleton($prefix)>
-Evaluate the environment variables C<TMPDIR>, C<TMP>, and C<TEMP> in
-order to find the system temporary directory.
+Generate a skeleton of empty directories in the C<TEXMFSYSVAR> tree.
=cut
-sub get_system_tmpdir {
- my $systmp=0;
- $systmp||=getenv 'TMPDIR';
- $systmp||=getenv 'TMP';
- $systmp||=getenv 'TEMP';
- $systmp||='/tmp';
- return "$systmp";
+sub make_var_skeleton {
+ my $prefix=shift;
+ my $mode=0777;
+
+ mkdirhier "$prefix/tex/generic/config", $mode;
+ mkdirhier "$prefix/dvipdfm/config", $mode;
+ mkdirhier "$prefix/tex/plain/config", $mode;
+ mkdirhier "$prefix/dvips/config", $mode;
+ mkdirhier "$prefix/fonts/map/dvipdfm/updmap", $mode;
+ mkdirhier "$prefix/fonts/map/dvips/updmap", $mode;
+ mkdirhier "$prefix/fonts/map/pdftex/updmap", $mode;
+ mkdirhier "$prefix/web2c", $mode;
+ mkdirhier "$prefix/xdvi", $mode;
+ mkdirhier "$prefix/tex/context/config", $mode;
}
=pod
-=item C<mkdirhier($path)>
+=item C<make_local_skeleton($prefix)>
-The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
+Generate a skeleton of empty directories in the C<TEXMFLOCAL> tree.
=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";
+sub make_local_skeleton {
+ my $prefix=shift;
+ my $mode=0755;
+
+ mkdirhier "$prefix/tex/latex/local", $mode;
+ mkdirhier "$prefix/tex/plain/local", $mode;
+ mkdirhier "$prefix/dvips/local", $mode;
+ mkdirhier "$prefix/bibtex/bib/local", $mode;
+ mkdirhier "$prefix/bibtex/bst/local", $mode;
+ mkdirhier "$prefix/fonts/tfm/local", $mode;
+ mkdirhier "$prefix/fonts/vf/local", $mode;
+ mkdirhier "$prefix/fonts/source/local", $mode;
+ mkdirhier "$prefix/fonts/type1/local", $mode;
+ mkdirhier "$prefix/metapost/local", $mode;
+ mkdirhier "$prefix/web2c", $mode;
+}
+
+
+=pod
+
+=back
+
+=head2 Miscellaneous
+
+Ideas from Fabrice Popineau's C<FileUtils.pm>.
+
+=over 6
+
+=item C<sort_uniq(@list)>
+
+The C<sort_uniq> function sorts the given array and throws away multiple
+occurrences of elements. It returns a sorted and unified array.
+
+=cut
+
+sub sort_uniq {
+ my (@l) = @_;
+ my ($e, $f, @r);
+ $f = "";
+ @l = sort(@l);
+ foreach $e (@l) {
+ if ($e ne $f) {
+ $f = $e;
+ push @r, $e;
}
}
+ return @r;
}
=pod
-=item C<make_var_skeleton($prefix)>
+=item C<push_uniq(\@list, @items)>
-Generate a skeleton of empty directories in the C<TEXMFSYSVAR> tree.
+The C<push_uniq> function pushes the last elements on the list referenced
+by the first argument.
=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";
+sub push_uniq {
+ # can't we use $l as a reference, and then use my? later ...
+ local (*l, @le) = @_;
+ foreach my $e (@le) {
+ if (! &member($e, @l)) {
+ push @l, $e;
+ }
+ }
}
=pod
-=item C<make_local_skeleton($prefix)>
+=item C<member($item, @list)>
-Generate a skeleton of empty directories in the C<TEXMFLOCAL> tree.
+The C<member> function returns true if the the first argument is contained
+in the list of the remaining arguments.
=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";
+sub member {
+ my ($e, @l) = @_;
+ my ($f);
+ foreach $f (@l) {
+ if ($e eq $f) {
+ return 1;
+ }
+ }
+ return 0;
}
-1;
+=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
@@ -554,6 +727,8 @@ GNU General Public License Version 2 or later.
=cut
+1;
+
### Local Variables:
### perl-indent-level: 2
### tab-width: 2
diff --git a/Master/tlpkg/doc/Perl-API.txt b/Master/tlpkg/doc/Perl-API.txt
index e4ea303ef0c..2b3200c2e74 100644
--- a/Master/tlpkg/doc/Perl-API.txt
+++ b/Master/tlpkg/doc/Perl-API.txt
@@ -265,23 +265,26 @@ Package TeXLive::TLUtils
------------------------
exported functions:
- sort_uniq(@list)
- push_uniq(\@list,@list)
- member($item, @list)
- debug($string)
-# dirname($file)
-# basename($file)
- initialze_installer
- getenv($string)
- which($string)
- 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);
+ platform;
+ platform_desc($platform);
+ win32;
+ unix;
+ getenv($string);
+ which($string);
+ program_exists($program);
+ get_system_tmpdir;
+ dirname($path);
+ basename($path);
+ dirname_and_basename($path);
+ mkdirhier($path);
+ copy($file, $target_dir);
+ media;
+ initialze_installer;
+ binaries_available_from_disk;
+ binaries_available_from_net;
+ make_var_skeleton($path);
+ make_local_skeleton($path);
+ sort_uniq(@list);
+ push_uniq(\@list, @items);
+ member($item, @list);
+ debug($string);