From 5c4b3ed2d37f791f6fca086b1bfbb82b89945196 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Tue, 6 Nov 2007 18:41:09 +0000 Subject: change add_tlpcontainer syntax in a serious way!!! git-svn-id: svn://tug.org/texlive/trunk@5378 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLPDB.pm | 62 +++++++++++++++++++++++++++++++++---------- 1 file changed, 48 insertions(+), 14 deletions(-) diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index cfd516f13e1..7086a60283f 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -187,11 +187,14 @@ sub available_architectures { =pod -=item C<< $tlpdb->add_tlpcontainer("foobar.ext" [, destination ] ) >> +=item C<< $tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] ) >> -The C functions takes as argument the path to an -package TLPOBJ, i.e., one generated by TLPOBJ->make_zip and adds it to -the installation. +Installs the package C<$pkg> from the container files in C<$ziploc>. If +C<$archrefs> is given then it must be a reference to a list of +architectures to be installed. If the normal (arch=all) package is +architecture dependent then all arch packages in this list are installed. +If C<$dest> is given then the files are +installed into it, otherwise into the location of the TLPDB. Note that this procedure does NOT check for dependencies. So if your package adds new dependencies they are not necessarily fulfilled. @@ -199,25 +202,56 @@ adds new dependencies they are not necessarily fulfilled. =cut sub add_tlpcontainer { - my ($self, $package, $dest) = @_; + my ($self, $package, $ziplocation, $archrefs, $dest) = @_; + my @archs; + if (defined($archrefs)) { + @archs = @$archrefs; + } + my $cwd = getcwd; + if ($ziplocation !~ m,^/,) { + $ziplocation = "$cwd/$ziplocation"; + } + my $tlpobj = $self->_add_tlpcontainer($package, $ziplocation, "all", $dest); + if ($tlpobj->is_arch_dependent) { + foreach (@$archrefs) { + $self->_add_tlpcontainer($package, $ziplocation, $_, $dest); + } + } +} + +sub _add_tlpcontainer { + my ($self, $package, $ziplocation, $arch, $dest) = @_; my $unpackprog; + my $args; # THIS IS NOW A STRONG ASSUMPTION!!! # The base of the installation is dirname($self->location)!!! if (not(defined($dest))) { $dest = TeXLive::TLUtils::dirname($self->location) ; } - die ("$package not readable!\n") unless ( -r $package ); - my $pkgname = TeXLive::TLUtils::basename($package); - if ($package =~ m/\.zip$/) { + my $container = "$ziplocation/$package"; + if ($arch ne "all") { + $container .= ".$arch"; + } + if (-r "$container.zip") { + $container .= ".zip"; $unpackprog="unzip"; - $pkgname =~ s/\.zip$//; + $args="-o -qq $container -d $dest"; + } elsif (-r "$container.lzma") { + $container .= ".lzma"; + $unpackprog="NO_IDEA_HOW_TO_UNPACK_LZMA"; + $args="NO IDEA WHAT ARGS IT NEEDS"; + die("lzma is checked for but not implemented, please edit TLPDB.pm\n"); } else { - die "Currently only zip packages allowed: $package!\n"; + die "Cannot find a package $container (.zip or .lzma) in $ziplocation\n"; } warn "Huuu, this needs testing and error checking!\n"; warn "Should we use -a -- adapt line endings etc?\n"; - `$unpackprog -o -qq $package -d $dest`; - my $tlpobj = new TeXLive::TLPOBJ; - $tlpobj->from_file("$dest/.tlpobj/$pkgname.tlpobj"); - $self->add_tlpobj($tlpobj); + `$unpackprog $args`; + # we only create/add tlpobj for arch eq "all" + if ($arch eq "all") { + my $tlpobj = new TeXLive::TLPOBJ; + $tlpobj->from_file("$dest/.tlpobj/$package.tlpobj"); + $self->add_tlpobj($tlpobj); + return $tlpobj; + } } -- cgit v1.2.3