add a function $tlpdb->add_tlpcontainer("foobar.ext" [, destination ] )

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.


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

1 files changed, 39 insertions, 1 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 2a621fa741d..cfd516f13e1 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -26,7 +26,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->writeout(FILEHANDLE);
   $tlpdb->save;
   $tlpdb->available_architectures();
-  $tlpdb->add_objpkg($tlpobj);
+  $tlpdb->add_tlpcontainer("foobar.ext" [, "destination" ] );
+  $tlpdb->add_tlpobj($tlpobj);
   $tlpdb->get_package("packagename");
   $tlpdb->list_packages;
   $tlpdb->package_revision("packagename");
@@ -41,6 +42,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
 use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory);
 use TeXLive::TLUtils;
 use TeXLive::TLPOBJ;
+use Cwd;
 
 my $_listdir;
 
@@ -185,6 +187,42 @@ sub available_architectures {
 
 =pod
 
+=item C<< $tlpdb->add_tlpcontainer("foobar.ext" [, destination ] ) >>
+
+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.
+
+Note that this procedure does NOT check for dependencies. So if your package
+adds new dependencies they are not necessarily fulfilled.
+
+=cut
+
+sub add_tlpcontainer {
+  my ($self, $package, $dest) = @_;
+  my $unpackprog;
+  # 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$/) {
+    $unpackprog="unzip";
+    $pkgname =~ s/\.zip$//;
+  } else {
+    die "Currently only zip packages allowed: $package!\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);
+}
+
+
+=pod
+
 =item C<< $tlpdb->get_package("packagename") >> 
 
 The C<get_package> function returns a reference to a C<TLPOBJ> object