change add_tlpcontainer syntax in a serious way!!!

git-svn-id: svn://tug.org/texlive/trunk@5378 c570f23f-e606-0410-a88d-b1316a301751

1 files 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<add_tlpcontainer> 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;
+  }
 }