implement relative package building

relative packages are ready to be unpacked INTO a texmf tree, i.e. the 
leading path component has been removed. In this case the tlpobj file
is placed into the root of the container


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

2 files changed, 48 insertions, 9 deletions

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 0a3b47e8daa..3ef9f305ae0 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -357,7 +357,7 @@ sub writeout_simple {
 }
 
 sub make_container {
-  my ($self,$type,$instroot,$destdir,$containername) = @_;
+  my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
   if (not(defined($containername))) {
     $containername = $self->name;
   }
@@ -366,18 +366,18 @@ sub make_container {
   }
   die("Undefined instroot argument!") if (not(defined($instroot)));
   # first build the arch independent part
-  $self->_make_container($type,$instroot,$destdir,$containername,"all");
+  $self->_make_container($type,$instroot,$destdir,$containername,$relative,"all");
   # now the $pkg.$arch.zip
   if ($self->is_arch_dependent) {
     foreach my $t (keys %{$self->{'binfiles'}}) {
       &TeXLive::TLUtils::debug("arch=$t");
-      $self->_make_container($type,$instroot,$destdir,"$containername.$t",$t);
+      $self->_make_container($type,$instroot,$destdir,"$containername.$t",$relative,$t);
     }
   }
 }
 
 sub _make_container {
-  my ($self,$type,$instroot,$destdir,$containername,$arch) = @_;
+  my ($self,$type,$instroot,$destdir,$containername,$relative,$arch) = @_;
   my @files = ();
   my $compresscmd;
   my $tlpobjdir = "$InfraLocation/tlpobj";
@@ -404,6 +404,23 @@ sub _make_container {
     &TeXLive::TLUtils::debug("Not creating empty container file for $containername");
     return;
   }
+  # we do relative packages ONLY if the files do NOT span multiple
+  # texmf trees. check this here
+  my $tltree;
+  if ($relative) {
+    foreach (@files) {
+      my $tmp;
+      ($tmp) = split m@/@;
+      if (defined($tltree) && ($tltree ne $tmp)) {
+        die "Not generating relative package for multiple tree spanning packages!\n";
+      } else {
+        $tltree = $tmp;
+      }
+    }
+    my @nf;
+    map { s@^$tltree/@@ ; push @nf, $_; } @files;
+    @files = @nf;
+  }
   my $cwd = &getcwd;
   if ("$destdir" !~ m@^/@) {
     # we have an relative containerdir, so we have to make it absolute
@@ -411,6 +428,12 @@ sub _make_container {
   }
   &mkpath("$destdir") if (! -d "$destdir");
   chdir($instroot);
+  # in the relative case we have to chdir to the respective tltree
+  # and put the tlpobj into the root!
+  if ($relative) { 
+    chdir("./$tltree");
+    $tlpobjdir = ".";
+  }
   if ($arch eq "all") {
     # we add the .tlpobj into the .tlpobj directory
     my $removetlpobjdir = 0;
@@ -423,12 +446,13 @@ sub _make_container {
     close(TMP);
     push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
   }
+  print "name=$containername\n";
   if ($type eq "zip") {
-    $zipname .= ".zip";
+    $containername .= ".zip";
       if ($^O =~ /MSWin32/) {
-      $compresscmd = "| zip -9\@or $destdir/$zipname > $nul"
+      $compresscmd = "| zip -9\@or $destdir/$containername > $nul"
     } else {
-      $compresscmd = "| zip -9\@ory $destdir/$zipname > $nul"
+      $compresscmd = "| zip -9\@ory $destdir/$containername > $nul"
     }
   } elsif ($type eq "lzma") {
     $containername .= ".tar.lzma";
@@ -918,7 +942,7 @@ or the filehandle if given:
 
 debugging function for comparison with C<tpm>/C<tlps>, will go away.
 
-=item C<make_container($type,$instroot[, $destdir[, $containername]])>
+=item C<make_container($type,$instroot[, $destdir[, $containername[, $relative]]])>
 
 creates a container file of the arch B<independent> files in the C<TLPOBJ>
 in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used).
@@ -943,6 +967,16 @@ contain this tlpobj file, while C<$containername.$arch.$extension> does NOT.
 The argument C<$instroot> specifies the root of the installation from
 which the files should be taken.
 
+If the argument C<$relative> is present and true (perlish true) AND the 
+packages does not span multiple texmf trees (i.e., all the first path 
+components of all files are the same) then a relative packages is created,
+i.e., the first path component is stripped. In this case the tlpobj file
+is placed into the root of the installation. 
+
+This is used to distribute packages which can be installed in any arbitrary 
+texmf tree (of other distributions, too).
+
+
 =item C<recompute_sizes($tltree)>
 
 recomputes the sizes based on the information present in C<$tltree>.
diff --git a/Master/tlpkg/bin/tlpdb2container b/Master/tlpkg/bin/tlpdb2container
index 6467ec84e2d..cf75e532503 100755
--- a/Master/tlpkg/bin/tlpdb2container
+++ b/Master/tlpkg/bin/tlpdb2container
@@ -26,11 +26,13 @@ our $mydir;
 our $opt_debug = 0;
 my $opt_type = "zip";
 my $opt_outputdir = "./zip";
+my $opt_relative = 0;
 my $help = 0;
 
 GetOptions("outputdir=s"	=> \$opt_outputdir, 
 				   "all!"         => \$opt_all, 
 					 "debug!"       => \$opt_debug,
+					 "relative!"    => \$opt_relative,
 					 "type=s"       => \$opt_type,
 					 "help|?"       => \$help) or pod2usage(1);
 
@@ -55,7 +57,7 @@ sub main
   for my $pkg (@packs) {
     my $obj = $tlpdb->get_package ($pkg);
     die "$0: no TeX Live package named $pkg in $tlpdb_path.\n" if ! $obj;
-		$obj->make_container($opt_type,$Master,$opt_outputdir);
+		$obj->make_container($opt_type,$Master,$opt_outputdir,$pkg,$opt_relative);
   }
 }
 
@@ -85,6 +87,9 @@ The location where created container files are placed, defaults to ./zip.
 Specifies the type of container to be used. C<zip> generates zip files,
 while C<lzma> generates .tar.lzma files.
 
+=item B<-relative>
+Create a relative package, see TeXLive::TLPOBJ.1 for details.
+
 =back
 
 The standard options C<-help> and C<-debug> are also accepted.