summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-03-29 14:28:19 +0000
committerNorbert Preining <preining@logic.at>2008-03-29 14:28:19 +0000
commitd4eedbeb6301b3ed03a6b6f703020f7dc5dcdc63 (patch)
tree2e75e7be0a5c8389343b511710f59c3e87dd65d9 /Master/tlpkg/TeXLive
parent90c3bb4dc0c455df131af548a15d4cf875a86708 (diff)
too many changes, see email, basically tl.-package-manager work
git-svn-id: svn://tug.org/texlive/trunk@7221 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm25
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm420
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm115
-rw-r--r--Master/tlpkg/TeXLive/TLPSRC.pm2
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm51
5 files changed, 585 insertions, 28 deletions
diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index b2d359609e6..77ab65d8d6a 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -8,7 +8,7 @@ package TeXLive::TLConfig;
BEGIN {
use Exporter ();
- use vars qw( @ISA @EXPORT_OK );
+ use vars qw( @ISA @EXPORT_OK @EXPORT );
@ISA = qw(Exporter);
@EXPORT_OK = qw(
@MetaCategories
@@ -21,7 +21,12 @@ BEGIN {
$InfraLocation
$DatabaseName
$BlockSize
+ $NetArchive
+ $DiskArchive
+ $TeXLiveURL
+ $MaxBinOnCD
);
+ @EXPORT = @EXPORT_OK;
}
# Meta Categories do not ship files, but call only for other packages
@@ -47,6 +52,13 @@ our $BlockSize = 4096;
# the way we package things on the web
our $DefaultContainerExtension = "tar.lzma";
+our $NetArchive = "tlpkg";
+our $DiskArchive = "archive";
+our $TeXLiveURL = 'ftp://tug.org/texlive/tlnet/tldev';
+#our $TeXLiveURL = 'http://10.0.2.2/norbert/tltesting';
+
+our $MaxBinOnCD = 7;
+
1;
@@ -102,6 +114,17 @@ etc) relative to the root of the installation.
The assumed block size, currently 4k.
+=item C<$TeXLive::TLConfig::NetArchive>
+=item C<$TeXLive::TLConfig::DiskArchive>
+=item C<$TeXLive::TLConfig::TeXLiveURL>
+
+These values specify where to find packages.
+
+=item <$TeXLive::TLConfig::MaxBinOnCD>
+
+The maximum number of binary systems on the CD. This number must be
+smaller than the number of binaries available from the network.
+
=back
=head1 SEE ALSO
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
new file mode 100644
index 00000000000..8d38ff3c184
--- /dev/null
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -0,0 +1,420 @@
+# $Id: TLMedia.pm 6947 2008-03-13 00:40:12Z karl $
+# TeXLive::TLMedia.pm - module for accessing TeX Live Media
+# Copyright 2008 Norbert Preining
+#
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+
+package TeXLive::TLMedia;
+
+use TeXLive::TLConfig;
+use TeXLive::TLUtils qw(tllog copy win32 dirname mkdirhier conv_to_win_path basename);
+use TeXLive::TLPDB;
+use Cwd qw/abs_path/;
+
+sub shortnew
+{
+ my ($class, $location) = @_;
+ my $media;
+ # of no argument is given we assume NET and default URL
+ $location = "$TeXLiveURL" unless (defined($location));
+ # do media autodetection
+ if ($location =~ m,http://|ftp://,) {
+ $media = 'NET';
+ } else {
+ if (-d "$location/texmf/web2c") {
+ $media = 'DVD';
+ } elsif (-d "$location/$DiskArchive") {
+ $media = 'CD';
+ } else {
+ die ("Cannot find the correct media for $location, please specify!");
+ }
+ }
+ my $database;
+ if ($media eq 'NET') {
+ $database = "$location/$NetArchive/texlive.pkgver";
+ open(WGET, "wget -q --output-document=- $database|") or
+ tllog($::LOG_NORMAL, "Cannot get texlive.pkgver the net!\n");
+ } elsif ($media eq 'CD') {
+ $database = "$location/$DiskArchive/texlive.pkgver";
+ open(WGET, "<$database") or
+ tllog($::LOG_NORMAL, "Cannot get texlive.pkgver from CD!\n");
+ } else {
+ $database = "$location/$InfraLocation/texlive.pkgver";
+ open(WGET, "<$database") or
+ tllog($::LOG_NORMAL, "Cannot get texlive.pkgver from DVD!\n");
+ }
+ my %revs;
+ my @platforms;
+ while (<WGET>) {
+ chop;
+ my $line=$_;
+ my ($pkg, $rev) = split " ", $line;
+ $revs{$pkg} = $rev;
+ if ($rev == -1) {
+ push @platforms, $pkg;
+ }
+ }
+ $self->{'media'} = $media;
+ $self->{'location'} = $location;
+ %{ $self->{'pkgrevs'} } = %revs;
+ @{ $self->{'systems'} } = @platforms;
+ bless $self, $class;
+ return $self;
+}
+
+sub new
+{
+ my ($class, $location) = @_;
+ my $media;
+ # of no argument is given we assume NET and default URL
+ $location = "$TeXLiveURL" unless (defined($location));
+ # do media autodetection
+ if ($location =~ m,http://|ftp://,) {
+ $media = 'NET';
+ } else {
+ if (-d "$location/texmf/web2c") {
+ $media = 'DVD';
+ } elsif (-d "$location/$DiskArchive") {
+ $media = 'CD';
+ } else {
+ die ("Cannot find the correct media for $location, please specify!");
+ }
+ }
+ tllog($::LOG_DEBUG, "Loading $location/$InfraLocation/$DatabaseName ...\n");
+ my $tlpdb = TeXLive::TLPDB->new(root => "$location");
+ my (@all_c, @std_c, @lang_c, @lang_doc_c);
+ my (@schemes);
+ my %revs;
+ foreach my $pkg ($tlpdb->list_packages) {
+ my $tlpobj = $tlpdb->{'tlps'}{$pkg};
+ $revs{$tlpobj->name} = $tlpobj->revision;
+ if ($tlpobj->category eq "Collection") {
+ push @all_c, $pkg;
+ if ($pkg =~ /collection-lang/) {
+ push @lang_c, $pkg;
+ } elsif ($pkg =~ /documentation/) {
+ if ($pkg =~ /documentation-base/) {
+ push @std_c, $pkg;
+ } else {
+ push @lang_doc_c, $pkg;
+ }
+ } else {
+ push @std_c, $pkg;
+ }
+ } elsif ($tlpobj->category eq "Scheme") {
+ push @schemes, $pkg;
+ }
+ }
+ my (@systems);
+ @systems = $tlpdb->available_architectures;
+ $self->{'media'} = $media;
+ $self->{'location'} = $location;
+ $self->{'tlpdb'} = $tlpdb;
+ $self->{'release'} = $tlpdb->config_release;
+ @{ $self->{'all_collections'} } = @all_c;
+ @{ $self->{'std_collections'} } = @std_c;
+ @{ $self->{'lang_collections'} } = @lang_c;
+ @{ $self->{'lang_doc_collections'} } = @lang_doc_c;
+ @{ $self->{'schemes'} } = @schemes;
+ @{ $self->{'systems'} } = @systems;
+ %{ $self->{'pkgrevs'} } = %revs;
+ bless $self, $class;
+ return $self;
+}
+
+# returns 0 for error
+# otherwise a bitmap which specifies what commands have to be run
+# always: 0x0001 mktexlsr
+# addMap: 0x0010 updmap-sys
+# BuildFormat: 0x0100 fmtutil-sys --missing
+# BuildLanguageDat: 0x1000 fmtutil-sys --by-hyphen language.dat
+#
+sub install_package {
+ my ($self, $pkg, $totlpdb, $nodepends, $fallbackmedia) = @_;
+ my $fromtlpdb = $self->tlpdb;
+ my $ret;
+ die("TLMedia not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
+ my $tlpobj = $fromtlpdb->get_package($pkg);
+ if (!defined($tlpobj)) {
+ if (defined($fallbackmedia)) {
+ if ($ret = $fallbackmedia->install_package($pkg,$totlpdb)) {
+ tllog($::LOG_DEBUG, "installed $pkg from fallback");
+ return $ret;
+ } else {
+ tllog($::LOG_NORMAL, "couldn't find $pkg");
+ return 0;
+ }
+ } else {
+ tllog($::LOG_NORMAL, "couldn't find $pkg");
+ return 0;
+ }
+ } else {
+ my $container_src_split = $fromtlpdb->config_src_container;
+ my $container_doc_split = $fromtlpdb->config_doc_container;
+ # get options about src/doc splitting from $totlpdb
+ my $opt_src = $totlpdb->option_srcfiles;
+ my $opt_doc = $totlpdb->option_docfiles;
+ tllog($::LOG_NORMAL, "Installing: $pkg\n");
+ foreach my $h (@::install_packages_hook) {
+ &$h("Installing: $package");
+ }
+ my $container;
+ my @installfiles;
+ my $location = $self->location;
+ foreach ($tlpobj->runfiles) {
+ s!^!$location/!;
+ push @installfiles, $_;
+ }
+ foreach ($tlpobj->allbinfiles) {
+ s!^!$location/!;
+ push @installfiles, $_;
+ }
+ if ($opt_src) {
+ foreach ($tlpobj->srcfiles) {
+ s!^!$location/!;
+ push @installfiles, $_;
+ }
+ }
+ if ($opt_doc) {
+ foreach ($tlpobj->docfiles) {
+ s!^!$location/!;
+ push @installfiles, $_;
+ }
+ }
+ my $media = $self->media;
+ if ($media eq 'DVD') {
+ $container = \@installfiles;
+ } elsif ($media eq 'CD') {
+ if (-r "$location/$DiskArchive/$pkg.zip") {
+ $container = "$location/$DiskArchive/$pkg.zip";
+ } elsif (-r "$location/$DiskArchive/$pkg.tar.lzma") {
+ $container = "$location/$DiskArchive/$pkg.tar.lzma";
+ } else {
+ # for now only warn and return, should (?) be die!?
+ warn "Cannot find a package $pkg (.zip or .lzma) in $location/$DiskArchive\n";
+ next;
+ }
+ } elsif (&media eq 'NET') {
+ $container = "$location/$NetArchive/$pkg.$DefaultContainerExtension";
+ }
+ $self->_install_package($container,\@installfiles,$totlpdb);
+ # if we are installing from CD or NET we have to fetch the respective
+ # source and doc packages $pkg.source and $pkg.doc and install them, too
+ if (($media eq 'NET') || ($media eq 'CD')) {
+ # we install split containers under the following conditions:
+ # - the container were split generated
+ # - src/doc files should be installed
+ # - the package is not already a split one (like .i386-linux)
+ # - there are actually src/doc files present
+ if ($container_src_split && $opt_src &&
+ ($pkg !~ m/\./) && $tlpobj->srcfiles) {
+ my $srccontainer = $container;
+ $srccontainer =~ s/(.tar.lzma|.zip)/.source$1/;
+ $self->_install_package($srccontainer,\@installfiles,$totlpdb);
+ }
+ if ($container_doc_split && $opt_doc &&
+ ($pkg !~ m/\./) && $tlpobj->docfiles) {
+ my $doccontainer = $container;
+ $doccontainer =~ s/(.tar.lzma|.zip)/.doc$1/;
+ $self->_install_package($doccontainer,\@installfiles,$totlpdb);
+ }
+ }
+ # we don't want to have wrong information in the tlpdb, so remove the
+ # src/doc files if they are not installed ...
+ if (!$opt_src) {
+ $tlpobj->clear_srcfiles;
+ }
+ if (!$opt_doc) {
+ $tlpobj->clear_docfiles;
+ }
+ $totlpdb->add_tlpobj($tlpobj);
+ $totlpdb->save;
+ # compute the return value
+ $ret |= 0x0001; # mktexlsr
+ foreach my $e ($tlpobj->executes) {
+ if ($e =~ m/^add/) {
+ $ret |= 0x0010;
+ } elsif ($e =~ m/^BuildFormat/) {
+ $ret |= 0x0100;
+ } elsif ($e =~ m/^BuildLanguageDat/) {
+ $ret |= 0x1000;
+ } else {
+ warn("Unknown execute $e in $pkg");
+ }
+ }
+ # now install all the depends if they are not already present
+ if (!$nodepends) {
+ foreach my $d ($tlpobj->depends) {
+ if ($d =~ m/^(.*)\.ARCH$/) {
+ my $foo = $1;
+ foreach my $a ($totlpdb->available_architectures) {
+ if (!defined($totlpdb->get_package("$foo.$a"))) {
+ $ret |= $self->install_package("$foo.$a", $totlpdb, $nodepends, $fallbackmedia);
+ }
+ }
+ } elsif ($d =~ m/^(.*).win32$/) {
+ # install only of win32 is under the available archs
+ if (TeXLive::TLUtils::member("win32",$totlpdb->available_architectures)) {
+ $ret |= $self->install_package($d, $totlpdb, $nodepends, $fallbackmedia);
+ }
+ } else {
+ if (!defined($totlpdb->get_package($d))) {
+ # we have to install it!
+ $ret |= $self->install_package($d, $totlpdb, $nodepends, $fallbackmedia);
+ }
+ }
+ }
+ }
+ return $ret;
+ }
+}
+
+sub _install_package {
+ sub mysystem {
+ my $cmd = shift;
+ # print "DEBUG: $cmd\n";
+ system("$cmd");
+ }
+ my ($self, $what, $filelistref, $totlpdb) = @_;
+ my $buffer;
+ my $offset;
+ my $blocksize=2048;
+ my $media = $self->media;
+ my $target = $totlpdb->root;
+
+ $blocksize=4096 if ($media eq 'NET');
+
+ my @filelist = @$filelistref;
+
+ my $bindir = "$target/tlpkg/installer";
+ my $platform = $totlpdb->option_platform;
+ # unix defaults
+ my $wget = "wget";
+ my $lzmadec = "$bindir/lzmadec.$platform";
+ my $tar = "tar";
+ if (win32()) {
+ $wget = conv_to_win_path("$bindir/wget.exe");
+ #$tar = conv_to_win_path("$bindir/bsdtar.exe");
+ # try Akira's tar.exe
+ $tar = conv_to_win_path("$bindir/tar.exe");
+ $lzmadec = conv_to_win_path("$lzmadec");
+ $target =~ s!/!\\!g;
+ }
+ if (ref $what) {
+ # we are getting a ref to a list of files, so install from DVD
+ foreach my $file (@$what) {
+ # @what is taken, not @filelist!
+ # is this still needed?
+ my $dn=dirname($file);
+ mkdirhier("$target/$dn");
+ copy "$file", "$target/$dn";
+ }
+ } elsif ($what =~ m,http://|ftp://,) {
+ # we are installing from the NET
+ # currently the list of file @filelist is NOT EVALUATED!!!
+ if (win32()) {
+ # we need temporary files here
+ # tmpdir is $target/temp
+ my $fn = basename($what);
+ my $tarfile = $fn;
+ $tarfile =~ s/\.lzma$//;
+ mkdirhier("$target/temp");
+ tllog($::LOG_DEBUG, "Downloading $what to $target\\temp\\$fn\n");
+ tllog($::LOG_DEBUG, `$wget --tries=2 --timeout=60 -q -O \"$target\\temp\\$fn\" \"$what\" 2>\&1`);
+ tllog($::LOG_DEBUG, "Un-lzmaing $target\\temp\\$fn to $target\\temp\\$tarfile\n");
+ #tllog($::LOG_DEBUG, `type \"$target\\temp\\$fn\" | $lzmadec > \"$target\\temp\\$tarfile\" 2>&1`);
+ tllog($::LOG_DEBUG, `$lzmadec < \"$target\\temp\\$fn\" > \"$target\\temp\\$tarfile\" 2>&1`);
+ tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
+ tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
+ unlink("$target/temp/$tarfile", "$target/temp/$fn");
+ } else {
+ tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
+ tllog($::LOG_NORMAL, `$wget --tries=2 --timeout=60 -q -O- \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\"`);
+ }
+ } elsif ($what =~ m,\.tar.lzma$,) {
+ if (win32()) {
+ my $fn = basename($what);
+ my $tarfile = $fn;
+ $tarfile =~ s/\.lzma$//;
+ mkdirhier("$target/temp");
+ tllog($::LOG_DEBUG, "Un-lzmaing $what to $target\\temp\\$tarfile\n");
+ tllog($::LOG_DEBUG, `$lzmadec < \"$what\" > \"$target\\temp\\$tarfile\" 2>&1`);
+ tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
+ tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
+ unlink("$target/temp/$tarfile");
+ } else {
+ tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
+ tllog($::LOG_DEBUG, `cat \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\" 2>&1`);
+ }
+ } else {
+ die "Don't know how to install $what!\n";
+ }
+}
+
+
+
+# member access functions
+#
+sub media { my $self = shift ; return $self->{'media'}; }
+sub location { my $self = shift ; return $self->{'location'}; }
+sub tlpdb { my $self = shift ; return $self->{'tlpdb'}; }
+sub release { my $self = shift ; return $self->{'release'}; }
+sub all_collections { my $self = shift; return @{ $self->{'all_collections'} }; }
+sub std_collections { my $self = shift; return @{ $self->{'std_collections'} }; }
+sub lang_collections { my $self = shift; return @{ $self->{'lang_collections'} }; }
+sub lang_doc_collections { my $self = shift; return @{ $self->{'lang_doc_collections'} }; }
+sub schemes { my $self = shift; return @{ $self->{'schemes'} }; }
+sub systems { my $self = shift; return @{ $self->{'systems'} }; }
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+C<TeXLive::TLMedia> -- TeX Live Media module
+
+=head1 SYNOPSIS
+
+ use TeXLive::TLMedia;
+
+ my $tlnet = TeXLive::TLMedia->new('NET');
+ my $tlneo = TeXLive::TLMedia->new('NET','http://www.ctan.org/mirror/tl/');
+ my $tlcd = TeXLive::TLMedia->new('CD','/mnt/tl-cd/');
+ my $tldvd = TeXLive::TLMedia->new('DVD','/mnt/tl-dvd/');
+
+=head1 DESCRIPTION
+
+missing
+
+=head1 MEMBER ACCESS FUNCTIONS
+
+scalars: media, location, tlpdb, release
+lists: all_collections, std_collections, lang_collections, lang_doc_collections,
+schemes, systems
+
+=back
+
+=head1 SEE ALSO
+
+The modules L<TeXLive::TLConfig>, L<TeXLive::TLUtils>, L<TeXLive::TLPOBJ>,
+L<TeXLive::TLPDB>, L<TeXLive::TLTREE>.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 696342ecf18..19df28c30e6 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -28,6 +28,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$tlpdb->available_architectures();
$tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] );
$tlpdb->add_tlpobj($tlpobj);
+ $tlpdb->needed_by($pkg);
+ $tlpdb->remove_package($pkg);
$tlpdb->get_package("packagename");
$tlpdb->list_packages;
$tlpdb->find_file("filename");
@@ -51,8 +53,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
=cut
use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
- $DatabaseName);
-use TeXLive::TLUtils qw(dirname mkdirhier tllog);
+ $DatabaseName $MetaCategoriesRegexp);
+use TeXLive::TLUtils qw(dirname mkdirhier tllog member);
use TeXLive::TLPOBJ;
my $_listdir;
@@ -103,6 +105,59 @@ sub add_tlpobj {
=pod
+=item C<< $tlpdb->needed_by($pkg) >>
+
+Returns an array of package names depending on $pkg.
+
+=cut
+
+sub needed_by {
+ my ($self,$pkg) = @_;
+ my @ret;
+ # we only check collections and schemes ...
+ foreach my $p ($self->list_packages) {
+ my $tlp = $self->get_package($p);
+ if ($tlp->category =~ m/$MetaCategoriesRegexp/) {
+ foreach my $d ($tlp->depends) {
+ if ($d =~ m/^(.*)\.win32$/) {
+ if (member("win32", $self->available_architectures)) {
+ if ($d eq $pkg) {
+ push @ret, $p;
+ last;
+ }
+ }
+ } else {
+ if ($d eq $pkg) {
+ push @ret, $p;
+ last;
+ }
+ }
+ }
+ }
+ }
+ return @ret;
+}
+
+=pod
+
+=item C<< $tlpdb->remove_package($pkg) >>
+
+Remove the package named C<$pkg> from the tlpdb. Gives a warning if the
+package is not present
+
+=cut
+
+sub remove_package {
+ my ($self,$pkg) = @_;
+ if (defined($self->{'tlps'}{$pkg})) {
+ delete $self->{'tlps'}{$pkg};
+ } else {
+ warn "Cannot find package $pkg for removal in tlpdb!";
+ }
+}
+
+=pod
+
=item C<< $tlpdb->from_file($filename) >>
The C<from_file> function initializes the C<TLPDB> in case the
@@ -198,7 +253,7 @@ sub available_architectures {
my $self = shift;
my @packs = $self->list_packages;
my @archs;
- map { s@^$tltree/@@ ; push @nf, $_; } @files;
+ # map { s@^$tltree/@@ ; push @nf, $_; } @files;
map { s/^bin-tex\.// ; push @archs, $_ ; } grep(/^bin-tex\.(.*)$/, @packs);
return @archs;
}
@@ -602,6 +657,8 @@ sub config_src_container {
return 0;
}
+=pod
+
=item C<< $tlpdb->config_doc_container >>
Returns 1 if the the texlive config option for doc files splitting on
@@ -621,6 +678,8 @@ sub config_doc_container {
return 0;
}
+=pod
+
=item C<< $tlpdb->config_doc_container >>
Returns the currently set default container format. See Options below.
@@ -639,6 +698,8 @@ sub config_container_format {
return "";
}
+=pod
+
=item C<< $tlpdb->config_release >>
Returns the currently set release. See Options below.
@@ -659,6 +720,54 @@ sub config_release {
=pod
+=item C<< $tlpdb->option_XXXXX >>
+
+Need to be documented
+
+=cut
+
+sub _option_value {
+ my ($self,$key) = @_;
+ if (defined($self->{'tlps'}{'00texlive-installation.config'})) {
+ foreach my $d ($self->{'tlps'}{'00texlive-installation.config'}->depends) {
+ if ($d =~ m!^$key/(.*)$!) {
+ return "$1";
+ }
+ }
+ return "";
+ }
+ return;
+}
+sub _option_setting {
+ my ($self,$key) = @_;
+ if (defined($self->{'tlps'}{'00texlive-installation.config'})) {
+ foreach my $d ($self->{'tlps'}{'00texlive-installation.config'}->depends) {
+ if ($d =~ m!^$key$!) {
+ return 1;
+ }
+ }
+ return 0;
+ }
+ return;
+}
+
+sub option_symlinks { my $self = shift; return $self->_option_setting("symlinks"); }
+sub option_docfiles { my $self = shift; return $self->_option_setting("docfiles"); }
+sub option_srcfiles { my $self = shift; return $self->_option_setting("srcfiles"); }
+sub option_formats { my $self = shift; return $self->_option_setting("formats"); }
+sub option_letter { my $self = shift; return $self->_option_setting("letter"); }
+sub option_location { my $self = shift; return $self->_option_value("location"); }
+sub option_TEXDIR { my $self = shift; return $self->_option_value("TEXDIR"); }
+sub option_TEXMFSYSVAR { my $self = shift; return $self->_option_value("TEXMFSYSVAR"); }
+sub option_TEXMFLOCAL { my $self = shift; return $self->_option_value("TEXMFLOCAL"); }
+sub option_TEXMFHOME { my $self = shift; return $self->_option_value("TEXMFHOME"); }
+sub option_sys_bin { my $self = shift; return $self->_option_value("sys_bin"); }
+sub option_sys_man { my $self = shift; return $self->_option_value("sys_man"); }
+sub option_sys_info { my $self = shift; return $self->_option_value("sys_info"); }
+sub option_platform { my $self = shift; return $self->_option_value("platform"); }
+
+=pod
+
=item C<< $tlpdb->fmtutil_cnf_lines >>
The function C<fmtutil_cnf_lines> returns the list of a fmtutil.cnf file
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm
index efa390a2194..c1cf75656a1 100644
--- a/Master/tlpkg/TeXLive/TLPSRC.pm
+++ b/Master/tlpkg/TeXLive/TLPSRC.pm
@@ -82,7 +82,7 @@ sub from_file
if ($line =~ /^ /) {
die "$srcfile: continuation line not allowed in tlpsrc: $line\n";
}
- if ($line =~ /^name\s*([-\w]+(\.win32)?|00texlive\..*)$/) {
+ if ($line =~ /^name\s*([-\w]+(\.win32)?|00texlive\..*|0texlive\..*)$/) {
$name = "$1";
$started && die("$srcfile: tlpsrc cannot have two name directives");
$started = 1;
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index a96df736414..14fbc8bc8cc 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -51,7 +51,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::create_fmtutil($tlpdb,$dest,$localconf);
TeXLive::TLUtils::create_updmap($tlpdb,$dest,$localconf);
TeXLive::TLUtils::create_language($tlpdb,$dest,$localconf);
- TeXLive::TLUtils::install_packages($from_tlpdb,$to_tlpdb,@list);
+ TeXLive::TLUtils::install_packages($from_tlpdb,$to_tlpdb,$what, $netarchsref, $opt_src, $opt_doc)>);
TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform);
=head2 Miscellaneous
@@ -104,14 +104,13 @@ BEGIN {
&member
&kpsewhich
&quotewords
+ &conv_to_win_path
);
@EXPORT = qw(tllog);
}
-use TeXLive::TLConfig qw($DefaultContainerExtension);
-
-
+use TeXLive::TLConfig;
=pod
@@ -541,10 +540,10 @@ sub install_packages {
if (&media eq 'DVD') {
$container = \@installfiles;
} elsif (&media eq 'CD') {
- if (-r "$::installerdir/$::diskarchive/$package.zip") {
- $container = "$::installerdir/$::diskarchive/$package.zip";
- } elsif (-r "$::installerdir/$::diskarchive/$package.tar.lzma") {
- $container = "$::installerdir/$::diskarchive/$package.tar.lzma";
+ if (-r "$::installerdir/$DiskArchive/$package.zip") {
+ $container = "$::installerdir/$DiskArchive/$package.zip";
+ } elsif (-r "$::installerdir/$DiskArchive/$package.tar.lzma") {
+ $container = "$::installerdir/$DiskArchive/$package.tar.lzma";
} else {
# ok, it could be a binary package which should be installed from
# the net
@@ -552,19 +551,19 @@ sub install_packages {
foreach my $a (@$netarchs) {
if ($package =~ m/\.$a$/) {
# ok this is a binary we should install from the net
- $container = "$::texlive_url/$::netarchive/$package.$DefaultContainerExtension";
+ $container = "$TeXLiveURL/$NetArchive/$package.$DefaultContainerExtension";
$donefromnet = 1;
last;
}
}
if (!$donefromnet) {
# for now only warn and return, should (?) be die!?
- warn "Cannot find a package $package (.zip or .lzma) in $::installerdir/$::diskarchive\n";
+ warn "Cannot find a package $package (.zip or .lzma) in $::installerdir/$DiskArchive\n";
next;
}
}
} elsif (&media eq 'NET') {
- $container = "$::texlive_url/$::netarchive/$package.$DefaultContainerExtension";
+ $container = "$TeXLiveURL/$NetArchive/$package.$DefaultContainerExtension";
}
install_package($container,\@installfiles,$totlpdb->root,$vars{'this_platform'});
# if we are installing from CD or NET we have to fetch the respective
@@ -704,7 +703,6 @@ sub install_package {
}
}
-
sub install_package_old {
# either a list of files or a name of one .zip or .tar.lzma file.
my @what=@_;
@@ -734,7 +732,7 @@ sub install_package_old {
copy "$file", "$target/$dn";
}
} elsif (&media eq 'CD') {
- my $package="$::installerdir/$::diskarchive/$what[0]";
+ my $package="$::installerdir/$DiskArchive/$what[0]";
open IN, "$package", or warn "Can't open '$package': $!\n"
or die "Can't open '$package': $!\n";
binmode IN;
@@ -755,7 +753,7 @@ sub install_package_old {
close OUT;
close IN;
} elsif (&media eq 'NET') {
- my $package="$::texlive_url/$::netarchive/$what[0]";
+ my $package="$TeXLiveURL/$NetArchive/$what[0]";
system "$wget $package|$lzmadec|$tar $target";
} else {
die "This can't happen.";
@@ -783,7 +781,7 @@ CD/DVD.
sub media {
unless (defined $::_media_) {
- if (-d "$::installerdir/$::diskarchive") {
+ if (-d "$::installerdir/$DiskArchive") {
$::_media_='CD';
} elsif (-d "$::installerdir/texmf/web2c") {
$::_media_='DVD';
@@ -826,7 +824,7 @@ sub architectures_available {
my @dir;
my @platforms;
if (&media eq "CD") {
- opendir DIR, "$::installerdir/$::diskarchive";
+ opendir DIR, "$::installerdir/$DiskArchive";
@dir=readdir DIR;
chomp @dir;
for (@dir) {
@@ -855,7 +853,7 @@ sub architectures_available {
The function C<additional_architectures_available_from_net> returns a
list of additional platforms supported by the TeX Live server. It
-downloads the file C<$::texlive_url/$::netarchive/texlive.pkgver> and
+downloads the file C<$TeXLiveURL/$NetArchive/texlive.pkgver> and
creates a new object c<$::tlpdb_netbin>. The argument is a reference of
the global C<%vars> hash.
@@ -864,7 +862,7 @@ the global C<%vars> hash.
sub additional_architectures_available_from_net {
my $vars=shift;
my @platforms;
- my $database="$::texlive_url/$::netarchive/texlive.pkgver";
+ my $database="$TeXLiveURL/$NetArchive/texlive.pkgver";
tllog($::LOG_NORMAL, "Loading '$database' ...\n");
my $wget = "wget";
@@ -1108,13 +1106,20 @@ writing permissions.
sub texdir_check {
my ($texdir) = shift; # PATH/texlive/2008
- return 1 if (win32());
my $texdirparent = dirname($texdir); # PATH/texlive
my $texdirpparent = dirname($texdirparent); # PATH
- if ( (-w $texdirpparent) ||
- ( (-d $texdirparent) && (-w $texdirparent) ) ||
- ( (-d $texdir) && (-w $texdir) ) ) {
- return 1;
+ if (win32()) {
+ if ( (TeXLive::TLWinGoo::dir_writable($texdirpparent)) ||
+ ( (-d $texdirparent) && (TeXLive::TLWinGoo::dir_writable($texdirparent)) ) ||
+ ( (-d $texdir) && (TeXLive::TLWinGoo::dir_writable($texdir)) ) ) {
+ return 1;
+ }
+ } else {
+ if ( (-w $texdirpparent) ||
+ ( (-d $texdirparent) && (-w $texdirparent) ) ||
+ ( (-d $texdir) && (-w $texdir) ) ) {
+ return 1;
+ }
}
return 0;
}