From 73c5ccf1eacaaf6057e330055ffa1b9965077f39 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 3 Dec 2007 17:29:03 +0000 Subject: factor out more of the install_package to TLUtils and make it more or less generic. git-svn-id: svn://tug.org/texlive/trunk@5700 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl.pl | 55 ++++------------- Master/tlpkg/TeXLive/TLConfig.pm | 1 + Master/tlpkg/TeXLive/TLPOBJ.pm | 16 ++++- Master/tlpkg/TeXLive/TLUtils.pm | 126 ++++++++++++++++++++++++++++++++++++--- 4 files changed, 147 insertions(+), 51 deletions(-) (limited to 'Master') diff --git a/Master/install-tl.pl b/Master/install-tl.pl index 653affbb69a..8a5d89a46b7 100755 --- a/Master/install-tl.pl +++ b/Master/install-tl.pl @@ -25,10 +25,10 @@ use TeXLive::TLUtils qw(initialize_installer media platform platform_desc debug which getenv win32 unix program_exists architectures_available additional_architectures_available_from_net get_system_tmpdir member mkdirhier make_var_skeleton make_local_skeleton install_package copy - create_fmtutil create_updmap create_language); + create_fmtutil create_updmap create_language install_packages); use TeXLive::TLPOBJ; use TeXLive::TLPDB; -use TeXLive::TLConfig; +use TeXLive::TLConfig qw($DefaultContainerExtension); use Getopt::Long; use strict; @@ -490,51 +490,22 @@ sub prepare_installation { $localtlpdb->root("$vars{'TEXDIR'}"); } + sub do_install_packages { + my @what; foreach my $package (sort keys %install) { - print "INSTALL $package\n" if ($install{$package} == 1); - my $tlpobj=$tlpdb->get_package($package); - if (&media eq 'DVD') { - my @allfiles = $tlpobj->all_files; - install_package(@allfiles); - } elsif (&media eq 'CD') { - my $container = "$package"; - if (-r "$::installerdir/$::diskarchive/$package.zip") { - $container = "$package.zip"; - } elsif (-r "$::installerdir/$::diskarchive/$package.tar.lzma") { - $container = "$package.tar.lzma"; - } else { - # ok, it could be a binary package which should be installed from - # the net - my $donefromnet = 0; - foreach my $k (keys %vars) { - if ($k =~ m/^netbin_(.*)$/) { - my $a = $1; - if (($vars{$k}) && ($package =~ m/\.$a$/)) { - # ok this is a binary we should install from the net - $::_media_ = 'NET'; - install_package("$package.$TeXLive::TLConfig::DefaultContainerExtension"); - $::_media_ = 'CD'; - $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"; - } - next; - } - install_package($container); - } elsif (&media eq 'NET') { - install_package("$package.$TeXLive::TLConfig::DefaultContainerExtension"); + push @what, $package if ($install{$package} == 1); + } + my @netarchs; + foreach my $k (keys %vars) { + if ($k =~ m/^netbin_(.*)$/) { + my $a = $1; + if ($vars{$k}) { push @netarchs, $a; } } - $localtlpdb->add_tlpobj($tlpobj); } - $localtlpdb->save; + install_packages($tlpdb,$localtlpdb,\@what,\@netarchs,$vars{'option_src'},$vars{'option_doc'}); } - + # do_postinst_stuff has to fix up the texmf tree and install some missing # files. The things to do are taken from the install-live.sh installer # of former times, and should be critically checked. diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm index f0819d34a41..b2d359609e6 100644 --- a/Master/tlpkg/TeXLive/TLConfig.pm +++ b/Master/tlpkg/TeXLive/TLConfig.pm @@ -17,6 +17,7 @@ BEGIN { $MetaCategoriesRegexp $CategoriesRegexp $DefaultCategory + $DefaultContainerExtension $InfraLocation $DatabaseName $BlockSize diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 73a692151a1..5709cd9bf1a 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -747,13 +747,23 @@ sub all_files { push (@ret, $self->srcfiles); my %binfiles = %{$self->binfiles}; - for my $arch (keys %binfiles) { + foreach my $arch (keys %binfiles) { push (@ret, @{$binfiles{$arch}}); } return @ret; } +sub allbinfiles { + my $self = shift; + my @ret; + my %binfiles = %{$self->binfiles}; + foreach my $arch (keys %binfiles) { + push (@ret, @{$binfiles{$arch}}); + } + return @ret; +} + # member access functions # @@ -1184,6 +1194,10 @@ adds or removes files for the given type (only for C, C, C). returns a list of all files of all types. +=item C + +returns a list of all binary files. + =back =head1 SEE ALSO diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 8dac6d9f6cf..710b99fc91b 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -40,7 +40,6 @@ C -- Utilities used in the TeX Live Infrastructure Modules TeXLive::TLUtils::dirname_and_basename($path); TeXLive::TLUtils::mkdirhier($path); TeXLive::TLUtils::copy($file, $target_dir); - TeXLive::TLUtils::install_package(@list); =head2 Installer Functions @@ -53,6 +52,8 @@ C -- Utilities used in the TeX Live Infrastructure Modules TeXLive::TLUtils::create_fmtutil($tlpdb,$texmfsysvar,$texmflocal); TeXLive::TLUtils::create_updmap($tlpdb,$texmfsysvar,$texmflocal); TeXLive::TLUtils::create_language($tlpdb,$texmfsysvar,$texmflocal); + TeXLive::TLUtils::install_packages($from_tlpdb,$to_tlpdb,@list); + TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform); =head2 Miscellaneous @@ -85,6 +86,7 @@ BEGIN { &mkdirhier © &install_package + &install_packages &media &initialize_installer &architectures_available @@ -102,8 +104,14 @@ BEGIN { ); } + +use TeXLive::TLConfig qw($DefaultContainerExtension); + + + =pod + =head2 Platform Detection =over 6 @@ -472,14 +480,114 @@ sub copy { } } -=pod +sub install_packages { + my ($fromtlpdb,$totlpdb,$what,$netarchs,$opt_src,$opt_doc) = @_; + foreach my $package (@$what) { + print "INSTALL $package\n"; + my $tlpobj=$fromtlpdb->get_package($package); + if (!defined($tlpobj)) { + die "STRANGE: $package not to be found in ", $fromtlpdb->root; + } + my $container; + my @installfiles; + push @installfiles, $tlpobj->runfiles; + push @installfiles, $tlpobj->allbinfiles; + push @installfiles, $tlpobj->srcfiles if ($opt_src); + push @installfiles, $tlpobj->docfiles if ($opt_doc); + 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"; + } else { + # ok, it could be a binary package which should be installed from + # the net + my $donefromnet = 0; + 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"; + $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"; + next; + } + } + } elsif (&media eq 'NET') { + $container = "$::texlive_url/$::netarchive/$package.$DefaultContainerExtension"; + } + install_package($container,\@installfiles,$totlpdb->root,$vars{'this_platform'}); + $totlpdb->add_tlpobj($tlpobj); + } + $totlpdb->save; +} -=back +sub install_package { + my ($what, $filelistref, $target, $platform) = @_; + my $buffer; + my $offset; + # shouldn't it be 4096 + my $blocksize=2048; + my @filelist = @$filelistref; -=cut + #my $lzmadec="$bindir/lzmadec_$platform"; + my $lzmadec="lzmadec"; + my $tar="/bin/tar -xf - -C"; + my $wget="wget -nv -O-"; + if (win32) { + my $bindir = "$::installerdir/tlpkg/bin/win32"; + $lzmadec="$bindir/lzma.exe -si -so"; + $tar="$bindir/tar.exe -xf - -C"; + $wget="$bindir/wget.exe -nv -O-"; + } + 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! + 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!!! + system "$wget $what|$lzmadec|$tar $target"; + } elsif ($what =~ m,\.tar.lzma$,) { + # we are installing from CD, currently only tar.lzma supported + # currently the list of file @filelist is NOT EVALUATED!!! + open IN, "$what", or warn "Can't open '$what': $!\n" + or die "Can't open '$what': $!\n"; + binmode IN; + + open OUT, "|$lzmadec|$tar $target"; + 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; + } else { + die "Don't know how to install $what!\n"; + } +} -sub install_package { + +sub install_package_old { # either a list of files or a name of one .zip or .tar.lzma file. my @what=@_; @@ -538,6 +646,8 @@ sub install_package { =pod +=back + =head2 Installer Functions =over 6 @@ -725,7 +835,7 @@ improved (checking for duplicates). =cut sub create_fmtutil { - my ($tlpdb,$texmfsysvar,$texmlocalpath) = @_; + my ($tlpdb,$texmfsysvar,$texmflocalpath) = @_; my $root = $tlpdb->root; my @lines = $tlpdb->fmtutil_cnf_lines; if (-r "$texmflocalpath/web2c/fmtutil-local.cnf") { @@ -747,7 +857,7 @@ sub create_fmtutil { } sub create_updmap { - my ($tlpdb,$texmfsysvar,$texmlocalpath) = @_; + my ($tlpdb,$texmfsysvar,$texmflocalpath) = @_; my $root = $tlpdb->root; my @lines = $tlpdb->updmap_cfg_lines; if (-r "$texmflocalpath/web2c/updmap-local.cfg") { @@ -769,7 +879,7 @@ sub create_updmap { } sub create_language { - my ($tlpdb,$texmfsysvar,$texmlocalpath) = @_; + my ($tlpdb,$texmfsysvar,$texmflocalpath) = @_; my $root = $tlpdb->root; my @lines = $tlpdb->language_dat_lines; if (-r "$texmflocalpath/tex/generic/config/language-local.dat") { -- cgit v1.2.3