diff options
author | Norbert Preining <preining@logic.at> | 2008-03-29 14:28:19 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-03-29 14:28:19 +0000 |
commit | d4eedbeb6301b3ed03a6b6f703020f7dc5dcdc63 (patch) | |
tree | 2e75e7be0a5c8389343b511710f59c3e87dd65d9 /Master/tlpkg/TeXLive | |
parent | 90c3bb4dc0c455df131af548a15d4cf875a86708 (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.pm | 25 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLMedia.pm | 420 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 115 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 51 |
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 "ewords + &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; } |