summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorReinhard Kotucha <reinhard.kotucha@web.de>2007-09-06 11:08:08 +0000
committerReinhard Kotucha <reinhard.kotucha@web.de>2007-09-06 11:08:08 +0000
commit690714a9558a1ba24d0b125fe88ad2ec0a3ec94c (patch)
treee9afaf511c331b6396c83079d5e7e2a199d637ef /Master
parent2710c0c4cba00ff0407f739e1f891fba97403416 (diff)
TLPDB.pm: Allow http:// or ftp:// in /path/to/texlive.tlpdb.
TLUtils.pm: More functions added. Perl-API.txt: Updated. git-svn-id: svn://tug.org/texlive/trunk@4898 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm80
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm283
-rw-r--r--Master/tlpkg/doc/Perl-API.txt19
3 files changed, 363 insertions, 19 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 3c392242a45..3c16d540402 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -10,7 +10,7 @@ package TeXLive::TLPDB;
=pod
=head1 NAME
-TeXLive::TLPDB - a database of TeX Live Packages
+C<TeXLive::TLPDB> -- A database of TeXLive Packages
=head1 SYNOPSIS
@@ -43,8 +43,17 @@ my $_listdir;
=pod
-C<TeXLive::TLPDB->new> creates a new C<TLPDB> object. If the argument
-location is given it will be initialized from this locations.
+=over 6
+
+=item C<< TeXLive::TLPDB->new >>
+
+=item C<< TeXLive::TLPDB->new(location => "$filename") >>
+
+C<< TeXLive::TLPDB->new >> creates a new C<TLPDB> object. If the
+argument C<location> is given it will be initialized from this
+location. C<$filename> is usually C</path/to/texlive.tlpdb>. If
+C<$filename> begins with C<http://> or C<ftp://>, the program C<wget>
+is used to download the file.
=cut
@@ -65,9 +74,12 @@ sub new {
=pod
+=item C<< $tlpdb->add_tlpobj($tlpobj) >>
+
The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB.
=cut
+
sub add_tlpobj {
my ($self,$tlp) = @_;
$self->{'tlps'}{$tlp->name} = $tlp;
@@ -75,10 +87,15 @@ sub add_tlpobj {
=pod
-The C<from_file> function initializes the C<TLPDB> in case the location
-was not given at generation time.
+=item C<< $tlpdb->from_file($filename) >>
+
+The C<from_file> function initializes the C<TLPDB> in case the
+location was not given at generation time. If C<$filename> begins
+with C<http://> or C<ftp://>, the program C<wget> is used to download
+the file.
=cut
+
sub from_file {
my $self = shift;
if (@_ != 1) {
@@ -90,7 +107,12 @@ sub from_file {
}
}
$self->location($_[0]);
- open(TMP,"<$_[0]") || die("Cannot open tlpdb file: $_[0]");
+ if ($_[0]=~/^(http|ftp):\/\//) {
+ open(TMP, "wget -nv --output-document=- $_[0]|")
+ || die("Cannot open tlpdb file: $_[0]");
+ } else {
+ open(TMP,"<$_[0]") || die("Cannot open tlpdb file: $_[0]");
+ }
my $found = 0;
do {
my $tlp = TeXLive::TLPOBJ->new;
@@ -104,10 +126,15 @@ sub from_file {
=pod
-The C<writeout> function writes the whole TLPDB to STDOUT, or to the file
-handle given as argument.
+=item C<< $tlpdb->writeout >>
+
+=item C<< $tlpdb->writeout(FILEHANDLE) >>
+
+The C<writeout> function writes the whole C<TLPDB> to C<STDOUT>, or to
+the file handle given as argument.
=cut
+
sub writeout {
my $self = shift;
my $fd = (@_ ? $_[0] : STDOUT);
@@ -121,10 +148,13 @@ sub writeout {
=pod
-The C<save> functions saves the TLPDB to the file which has been set
+=item C<< $tlpdb->save >>
+
+The C<save> functions saves the C<TLPDB> to the file which has been set
as location. If the location is undefined, die.
=cut
+
sub save {
my $self = shift;
open(FOO,">$self->{'location'}") || die("Cannot open $self->{'location'} for writing: $!");
@@ -134,10 +164,13 @@ sub save {
=pod
-The C<get_package> function returns a reference to an TLPOBJ object in case
-its name the the argument name coincide.
+=item C<< $tlpdb->get_package("packagename") >>
+
+The C<get_package> function returns a reference to a C<TLPOBJ> object
+in case its name the the argument name coincide.
=cut
+
sub get_package {
my ($self,$pkg) = @_;
if (defined($self->{'tlps'}{$pkg})) {
@@ -149,9 +182,12 @@ sub get_package {
=pod
+=item C<< $tlpdb->list_packages >>
+
The C<list_packages> function returns the list of all included packages.
=cut
+
sub list_packages {
my $self = shift;
return (sort keys %{$self->{'tlps'}});
@@ -159,10 +195,13 @@ sub list_packages {
=pod
-The C<package_revision> function returns the the revision of the
+=item C<< $tlpdb->package_revision("packagename") >>
+
+The C<package_revision> function returns the revision number of the
package named in the first argument.
=cut
+
sub package_revision {
my ($self,$pkg) = @_;
if (defined($self->{'tlps'}{$pkg})) {
@@ -174,10 +213,13 @@ sub package_revision {
=pod
+=item C<< $tlpdb->generate_packagelist >>
+
The C<generate_packagelist> lists all available TL Packages together
with their revisions.
=cut
+
sub generate_packagelist {
my $self = shift;
my $fd = (@_ ? $_[0] : STDOUT);
@@ -188,10 +230,15 @@ sub generate_packagelist {
=pod
+=item C<< $tlpdb->generate_listfiles >>
+
+=item C<< $tlpdb->generate_listfiles($destdir) >>
+
The C<generate_listfiles> generates the list files for the old
installers. This function will probably go away.
=cut
+
sub generate_listfiles {
my ($self,$destdir) = @_;
if (not(defined($destdir))) {
@@ -313,10 +360,13 @@ sub _generate_listfile {
=pod
+=item C<< $tlpdb->location("/path/to/texlive.tlpdb") >>
+
The function C<location> allows to read and set the location of the
-text file of the TeX Live Database.
+text file of the TeXLive database.
=cut
+
sub location {
my $self = shift;
if (@_) { $self->{'location'} = shift }
@@ -325,6 +375,8 @@ sub location {
=pod
+=item C<< $tlpdb->listdir >>
+
The function C<listdir> allows to read and set the packages variable
specifiying where generated list files are created.
@@ -335,9 +387,9 @@ sub listdir {
return $_listdir;
}
+=back
=pod
-
=head1 SEE ALSO
The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>,
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 5e5a88f60ec..f30b2410f1f 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -11,9 +11,10 @@
package TeXLive::TLUtils;
=pod
+
=head1 NAME
-TeXLive::TLUtils - utilities used in the TeX Live Infrastructure Modules
+C<TeXLive::TLUtils> -- Utilities used in the TeX Live Infrastructure Modules
=head1 SYNOPSIS
@@ -23,6 +24,15 @@ 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::getenv($string);
+ TeXLive::TLUtils::which($string);
+ TeXLive::TLUtils::initialze_installer;
+ TeXLive::TLUtils::media;
+ TeXLive::TLUtils::platform;
+ TeXLive::TLUtils::win32;
+ TeXLive::TLUtils::program_exists($program);
+ TeXLive::TLUtils::binaries_available_from_disk($platform);
+ TeXLive::TLUtils::binaries_available_from_net($platform);
=head1 DESCRIPTION
@@ -39,11 +49,26 @@ BEGIN {
@EXPORT_OK = qw(
&sort_uniq
&push_uniq
+ &member
+ &debug
+ &getenv
+ &which
+ &media
+ &platform
+ &initialize_installer
+ &win32
+ &program_exists
+ &binaries_available_from_disk
+ &binaries_available_from_net
);
}
=pod
+=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.
@@ -65,6 +90,8 @@ sub sort_uniq {
=pod
+=item C<push_uniq(\@list, @items)>
+
The C<push_uniq> function pushes the last elements on the list referenced
by the first argument.
@@ -82,6 +109,8 @@ sub push_uniq {
=pod
+=item C<member($item, @list)>
+
The C<member> function returns true if the the first argument is contained
in the list of the remaining arguments.
@@ -98,8 +127,32 @@ sub member {
return 0;
}
+
+=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.
+
+=cut
+
+sub initialize_installer {
+ ($::_installerdir_=$0)=~s/(.*)\/.*$/$1/;
+ &media;
+ &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.
@@ -109,10 +162,238 @@ sub debug {
print STDERR @_ if ($::opt_debug);
}
+=pod
+
+=item C<getenv($string)>
+
+Get an environment variable. It is assumed that the environment
+variable contains a path. On Windows all backslashes are replaced by
+forward slashes as required by Perl. If this behavior is not desired,
+use C<$ENV{"$variable"}> instead. C<0> is returned if the
+environment variable is not set.
+
+=cut
+
+sub getenv {
+ my $envvar=shift;
+ my $var=$ENV{"$envvar"};
+ return 0 unless (defined "$var");
+ if (&win32) {
+ $var=~s@\\@/@g; # change \ -> / (required by Perl)
+ }
+ return "$var";
+}
+
+=pod
+
+=item C<which($string)>
+
+C<which> does the same as the UNIX command C<which(1)>, but it is
+supposed to work on Windows too. On Windows we have to try all the
+extensions given in the C<PATHEXT> environment variable. We also try
+without appending an extension because if C<$string> comes from an
+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<media>
+
+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 media {
+ unless (defined $::_media_) {
+ if (-d "$::_installerdir_/archive") {
+ $::_media_="CD";
+ } elsif (-d "$::_installerdir_/texmf/web2c") {
+ $::_media_="DVD";
+ } else {
+ $::_media_="NET";
+ }
+ }
+ return $::_media_;
+}
+
+=pod
+
+=item C<platform>
+
+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 TeXLive 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 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 $::_platform_;
+}
+
+=pod
+
+=item C<win32>
+
+Return C<1> if platform is Windows and C<0> otherwise.
+
+=cut
+
+sub win32 {
+ return (&platform eq "win32")? 1:0;
+}
+
+=pod
+
+=item C<program_exists($program)>
+
+Return C<1> if C<$program> is in C<PATH> and C<0> otherwise.
+
+=cut
+
+sub program_exists {
+ my $program=shift;
+ return (&which ("$program"))? 0:1;
+}
+
+=pod
+
+=item C<binaries_available_from_disk>
+
+The function C<binaries_available_from_disk> returns a list of
+supported platforms. Media type has to be either C<CD> or C<DVD>.
+
+=cut
+
+sub binaries_available_from_disk {
+ my @dir;
+ my @platforms;
+ if (&media eq "CD") {
+ opendir DIR, "$::_installerdir_/archive";
+ } elsif (&media eq "DVD") {
+ opendir DIR, "$::_installerdir_/texmf/bin";
+ } else {
+ die "Media type must be CD or DVD.\n";
+ }
+ @dir=readdir DIR;
+ chomp @dir;
+ if (&media eq "CD") {
+ for (@dir) {
+ if (/bin-kpathsea.(.*).zip$/) {
+ push @platforms, $1;
+ }
+ }
+ } elsif (&media eq "DVD") {
+ for (@dir) {
+ push @platforms, $1 unless (/^\./);
+ }
+ } else {
+ die "Media type must be CD or DVD.\n";
+ }
+ return @platforms;
+}
+
+=pod
+
+=item C<binaries_available_from_net>
+
+The function C<binaries_available_from_net> returns a list of
+platforms supported by the TeXLive server. It downloads the file
+C<$::texlive_url/texlive.tlpdb> and looks for files
+C</^bin\/(.*)\/kpsewhich/>.
+
+=cut
+
+sub binaries_available_from_net {
+ my @platforms;
+ open TLPDB, "wget -q --output-document=- $::texlive_url/texlive.tlpdb|"
+ or die "Can't open $::texlive_url/texlive.tlpdb";
+ while (<TLPDB>) {
+ if (/^bin\/(.*)\/kpsewhich/) {
+ push @platforms, $1;
+ }
+ }
+ return @platforms;
+}
+
1;
+
=pod
+=back
+
=head1 SEE ALSO
The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>,
diff --git a/Master/tlpkg/doc/Perl-API.txt b/Master/tlpkg/doc/Perl-API.txt
index feac97832c0..d0557816fb3 100644
--- a/Master/tlpkg/doc/Perl-API.txt
+++ b/Master/tlpkg/doc/Perl-API.txt
@@ -210,10 +210,12 @@ Package variables:
&TeXLive::TLPDB->listdir
sets/returns the default location for created list files
-Constructore
+Constructor
TeXLive::TLPDB->new;
TeXLive::TLPDB->new ( location => "path/to/tldb/file" );
+ TeXLive::TLPDB->new ( location => "http://path/to/tldb/file" );
+ TeXLive::TLPDB->new ( location => "ftp://path/to/tldb/file" );
Read/Write functions (with argument set, without arg read)
@@ -221,7 +223,9 @@ Read/Write functions (with argument set, without arg read)
Input/Output
- $tldb->from_file($filename);
+ $tldb->from_file("path/to/tldb/file");
+ $tldb->from_file("http://path/to/tldb/file");
+ $tldb->from_file("ftp://path/to/tldb/file");
reads a tldb file (tlp descriptions separated by newlines)
$tldb->writeout
@@ -265,5 +269,12 @@ exported functions:
push_uniq(\@list,@list)
dirname($file)
basename($file)
-
-
+ getenv($string)
+ which($string)
+ initialze_installer
+ media
+ platform
+ win32
+ program_exists($program)
+ binaries_available_from_disk($platform)
+ binaries_available_from_net($platform)