- allow the generation of tar.lzma files

- specify the location of the infra stuff in TLConfig.pm


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

3 files changed, 79 insertions, 26 deletions

diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index b858798fca6..9c0b72ea254 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -17,6 +17,7 @@ BEGIN {
     $MetaCategoriesRegexp
     $CategoriesRegexp
     $DefaultCategory
+    $InfraLocation
   );
 }
 
@@ -33,6 +34,10 @@ our $CategoriesRegexp = '(Collection|Scheme|Package|TLCore|Documentation)';
 
 our $DefaultCategory = "Package";
 
+# location of various infra files (texlive.tlpdb, .tlpobj etc)
+# relative to a root (e.g., the Master/, or the installation path)
+our $InfraLocation = "tlpkg";
+
 1;
 
 
@@ -79,6 +84,11 @@ A regexp matching any category.
 
 The default category used when creating new packages.
 
+=item C<$TeXLive::TLConfig::InfraLocation>
+
+The location of various infrastructural files (texlive.tlpdb, tlpobj files,
+etc) relative to the root of the installation.
+
 =back
 
 =head1 SEE ALSO
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 2d20c35e31e..96f954ba923 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -6,7 +6,7 @@
 
 package TeXLive::TLPOBJ;
 
-use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp);
+use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation);
 use TeXLive::TLUtils;
 use File::Path;
 use Cwd;
@@ -356,37 +356,46 @@ sub writeout_simple {
   }
 }
 
+sub make_packagecontainer {
+  my ($self,$type,$instroot,$destdir,$zipname) = @_;
+  if ($type eq "zip") {
+    $self->make_zip($instroot,$destdir,$zipname);
+    return 0;
+  }
+  if ($type eq "lzma") {
+    warn("not implemented yet: lzma compression!\n");
+    return 1;
+  }
+  die("Container method $type unknown!\n");
+}
+
 
 sub make_zip {
-  my ($self,$instroot,$destdir,$zipname) = @_;
+  my ($self,$type,$instroot,$destdir,$zipname) = @_;
   my $zipn;
   if (not(defined($zipname))) {
-    $zipname = $self->name . ".zip";
+    $zipname = $self->name;
   }
   if (not(defined($destdir))) {
     $destdir = TeXLive::TLPOBJ->zipdir;
   }
   die("Undefined instroot argument!") if (not(defined($instroot)));
   # first build the arch independent part
-  $self->_make_zip($instroot,$destdir,$zipname,"all");
+  $self->_make_zip($type,$instroot,$destdir,$zipname,"all");
   # now the $pkg.$arch.zip
   if ($self->is_arch_dependent) {
     foreach my $t (keys %{$self->{'binfiles'}}) {
       &TeXLive::TLUtils::debug("arch=$t");
-      if ($zipname =~ /^(.*)\.zip$/) {
-        $zipn = "$1.$t.zip";
-      } else {
-        $zipn = "$zipname.$t.zip";
-      }
-      $self->_make_zip($instroot,$destdir,$zipn,$t);
+      $self->_make_zip($type,$instroot,$destdir,"$zipname.$t",$t);
     }
   }
 }
 
 sub _make_zip {
-  my ($self,$instroot,$destdir,$zipname,$arch) = @_;
+  my ($self,$type,$instroot,$destdir,$zipname,$arch) = @_;
   my @files = ();
   my $zipcmd;
+  my $tlpobjdir = "$InfraLocation/tlpobj";
   if ($arch ne "all") {
     push @files, @{$self->{'binfiles'}{$arch}};
   } else {
@@ -402,14 +411,12 @@ sub _make_zip {
   #   }
   if ($^O =~ /MSWin32/) {
     $nul = "nul";
-    $zipcmd = "| zip -9\@or "
   } else {
     $nul = "/dev/null";
-    $zipcmd = "| zip -9\@ory "
   }
   @files = TeXLive::TLUtils::sort_uniq(@files);
   if (!@files) {
-    &TeXLive::TLUtils::debug("Not creating empty zip file $zipname");
+    &TeXLive::TLUtils::debug("Not creating empty container file for $zipname");
     return;
   }
   my $cwd = &getcwd;
@@ -422,18 +429,31 @@ sub _make_zip {
   if ($arch eq "all") {
     # we add the .tlpobj into the .tlpobj directory
     my $removetlpobjdir = 0;
-    if (! -d ".tlpobj") {
-      &mkpath(".tlpobj");
+    if (! -d "$tlpobjdir") {
+      &mkpath("$tlpobjdir");
       $removetlpobjdir = 1;
     }
-    open(TMP,">.tlpobj/$self->{'name'}.tlpobj") or die "Cannot create .tlpobj/$self->{'name'}.tlpobj";
+    open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
     $self->writeout(\*TMP);
     close(TMP);
-    push @files, ".tlpobj/$self->{'name'}.tlpobj";
+    push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
+  }
+  if ($type eq "zip") {
+    $zipname .= ".zip";
+      if ($^O =~ /MSWin32/) {
+      $zipcmd = "| zip -9\@or $destdir/$zipname > $nul"
+    } else {
+      $zipcmd = "| zip -9\@ory $destdir/$zipname > $nul"
+    }
+  } elsif ($type eq "lzma") {
+    $zipname .= ".tar.lzma";
+    $zipcmd = "| tar --create --files-from=-  | lzma -c > $destdir/$zipname ";
+  } else {
+    die("Container method $type unknown!\n");
   }
   unlink($zipname);
-  print $zipcmd . "$destdir/$zipname" . " > $nul\n" if ($::opt_debug);
-  open ZIP, $zipcmd . "$destdir/$zipname" . " > $nul";
+  print "$zipcmd\n" if ($::opt_debug);
+  open ZIP, $zipcmd ;
   map {
     if (! -f $_) {
       print STDERR "!!!Error: non-existent $_\n";
@@ -444,8 +464,8 @@ sub _make_zip {
   close ZIP;
   if ($arch eq "all") {
     # cleaning up
-    unlink(".tlpobj/$self->{'name'}.tlpobj");
-    rmdir(".tlpobj") if $removetlpobjdir;
+    unlink("$tlpobjdir/$self->{'name'}.tlpobj");
+    rmdir("$tlpobjdir") if $removetlpobjdir;
   }
   chdir($cwd);
   print "Done $zipname\n" if ($::opt_debug);
@@ -925,7 +945,7 @@ all archs containing B<only> the binfiles are created, and
 the zipfile name is C<$zipname.$arch.zip>
 
 All the arch independent zip files B<also> contain the respective
-C<TLPOBJ> file in C<.tlpobj/$name.tlpobj> so C<$zipname.zip> does
+C<TLPOBJ> file in C<tlpkg/tlpobj/$name.tlpobj> so C<$zipname.zip> does
 contain this tlpobj file, while C<$zipname.$arch.zip> does NOT.
 
 The argument C<$instroot> specifies the root of the installation from
diff --git a/Master/tlpkg/bin/tlpdb2zip b/Master/tlpkg/bin/tlpdb2zip
index e22921d9f01..83393e64cde 100755
--- a/Master/tlpkg/bin/tlpdb2zip
+++ b/Master/tlpkg/bin/tlpdb2zip
@@ -24,12 +24,14 @@ use File::Path;
 my $opt_all = 0;
 our $mydir;
 our $opt_debug = 0;
+my $opt_type = "zip";
 my $opt_outputdir = "./zip";
 my $help = 0;
 
 GetOptions("outputdir=s"	=> \$opt_outputdir, 
 				   "all!"         => \$opt_all, 
 					 "debug!"       => \$opt_debug,
+					 "type=s"       => \$opt_type,
 					 "help|?"       => \$help) or pod2usage(1);
 
 pod2usage(-exitstatus => 0, -verbose => 2) if $help;
@@ -53,7 +55,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_zip($Master,$opt_outputdir);
+		$obj->make_zip($opt_type,$Master,$opt_outputdir);
   }
 }
 
@@ -63,7 +65,7 @@ __END__
 
 =head1 NAME
 
-tlpdb2zip - generate zip files from an installation
+tlpdb2zip - generate container files (zip,tar.lzma) of a package
 
 =head1 SYNOPSIS
 
@@ -71,11 +73,32 @@ tlpdb2zip [OPTION]...
 
 =head1 OPTIONS
 
-The standard options C<-help> and C<-debug> are accepted.
+=over 8
+
+=item B<-all>
+build container file for all packages present in the tlpdb.
+
+=item B<-outputdir> I<outputdir>
+The location where created container files are placed, defaults to ./zip.
+
+=item B<-type> I<zip|lzma>
+Specifies the type of container to be used. C<zip> generates zip files,
+while C<lzma> generates .tar.lzma files.
+
+=back
+
+The standard options C<-help> and C<-debug> are also accepted.
 See the tlpfiles documentation for details.
 
+
 =head1 DESCRIPTION
 
+To distribute packages over the network and on installation media the 
+packages are wrapped into container files. These container are either 
+simple zip files or tar.lzma file containing all the files of the package.
+
+B<tlpdb2zip> generates container files from a TeX Live Database and the
+respective installation.
 
 =head1 AUTHORS AND COPYRIGHT