implement bin file splitting into seperate packages

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

1 files changed, 204 insertions, 57 deletions

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 7e8766fb9fe..659cb45823d 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -47,6 +47,7 @@ sub new {
 }
 
 
+
 sub from_file {
   my $self = shift;
   if (@_ != 1) {
@@ -89,14 +90,14 @@ sub from_fh {
         die("Continuation of $lastcmd not allowed, please fix tlpobj: line = $line!\n");
       }
     }
-    if ($line =~ /^name\s*([-\w]+)$/) {
+    if ($line =~ /^name\s*([-.\w]+)$/) {
       $name = "$1";
       $lastcmd = "name";
       $self->name("$name");
       $started && die("Cannot have two name directives: $line!");
       $started = 1;
     } else {
-      $started || die("First directive needs to be 'name'");
+      $started || die("First directive needs to be 'name', not $line");
       if ($line =~ /^shortdesc\s+(.*)$/) {
         $self->{'shortdesc'} .= "$1";
         $lastcmd = "shortdesc";
@@ -359,38 +360,146 @@ sub writeout_simple {
   }
 }
 
+###################################################
+## OLD IMPLEMENTATION WITHOUT binfiles packaging split
+## where we generate the $name.$arch packages automatically
+##
+## sub make_container {
+##   my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
+##   if (not(defined($containername))) {
+##     $containername = $self->name;
+##   }
+##   if (not(defined($destdir))) {
+##     $destdir = TeXLive::TLPOBJ->containerdir;
+##   }
+##   die("Undefined instroot argument!") if (not(defined($instroot)));
+##   # first build the arch independent part
+##   $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",$relative,$t);
+##     }
+##   }
+## }
+## 
+## sub _make_container {
+##   my ($self,$type,$instroot,$destdir,$containername,$relative,$arch) = @_;
+##   my @files = ();
+##   my $compresscmd;
+##   my $tlpobjdir = "$InfraLocation/tlpobj";
+##   if ($arch ne "all") {
+##     push @files, @{$self->{'binfiles'}{$arch}};
+##   } else {
+##     push @files, $self->runfiles;
+##     push @files, $self->docfiles;
+##     push @files, $self->srcfiles;
+##   }
+##   # note that the Tpm.pm module had something like
+##   #   if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
+##   #     $zipcmd = "| zip -9\@ory "
+##   #   } else {
+##   #     $zipcmd = "| zip -9\@or "
+##   #   }
+##   if ($^O =~ /MSWin32/) {
+##     $nul = "nul";
+##   } else {
+##     $nul = "/dev/null";
+##   }
+##   @files = TeXLive::TLUtils::sort_uniq(@files);
+##   if (!@files) {
+##     &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
+##     $destdir = "$cwd/$destdir";
+##   }
+##   &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;
+##     if (! -d "$tlpobjdir") {
+##       &mkpath("$tlpobjdir");
+##       $removetlpobjdir = 1;
+##     }
+##     open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
+##     $self->writeout(\*TMP);
+##     close(TMP);
+##     push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
+##   }
+##   if ($type eq "zip") {
+##     $containername .= ".zip";
+##       if ($^O =~ /MSWin32/) {
+##       $compresscmd = "| zip -9\@or $destdir/$containername > $nul"
+##     } else {
+##       $compresscmd = "| zip -9\@ory $destdir/$containername > $nul"
+##     }
+##   } elsif ($type eq "lzma") {
+##     $containername .= ".tar.lzma";
+##     $compresscmd = "| tar --create --files-from=-  | lzma -c > $destdir/$containername ";
+##   } else {
+##     die("Container method $type unknown!\n");
+##   }
+##   unlink("$destdir/$containername");
+##   print "$compresscmd\n" if ($::opt_debug);
+##   open ZIP, $compresscmd ;
+##   map {
+##     if (! -f $_) {
+##       print STDERR "!!!Error: non-existent $_\n";
+##     } else {
+##       print ZIP "$_\n";
+##     }
+##   } @files;
+##   close ZIP;
+##   if ($arch eq "all") {
+##     # cleaning up
+##     unlink("$tlpobjdir/$self->{'name'}.tlpobj");
+##     rmdir("$tlpobjdir") if $removetlpobjdir;
+##   }
+##   chdir($cwd);
+##   print "Done $containername\n" if ($::opt_debug);
+## }
+#######################################################
+
 sub make_container {
   my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
-  if (not(defined($containername))) {
-    $containername = $self->name;
-  }
-  if (not(defined($destdir))) {
-    $destdir = TeXLive::TLPOBJ->containerdir;
-  }
-  die("Undefined instroot argument!") if (not(defined($instroot)));
-  # first build the arch independent part
-  $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",$relative,$t);
-    }
-  }
-}
-
-sub _make_container {
-  my ($self,$type,$instroot,$destdir,$containername,$relative,$arch) = @_;
   my @files = ();
   my $compresscmd;
   my $tlpobjdir = "$InfraLocation/tlpobj";
-  if ($arch ne "all") {
-    push @files, @{$self->{'binfiles'}{$arch}};
-  } else {
-    push @files, $self->runfiles;
-    push @files, $self->docfiles;
-    push @files, $self->srcfiles;
+  my %binf = $self->{'binfiles'};
+  foreach (keys %binf) {
+    push @files, @{$binf{$_}};
   }
+  push @files, $self->runfiles;
+  push @files, $self->docfiles;
+  push @files, $self->srcfiles;
   # note that the Tpm.pm module had something like
   #   if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
   #     $zipcmd = "| zip -9\@ory "
@@ -437,18 +546,16 @@ sub _make_container {
     chdir("./$tltree");
     $tlpobjdir = ".";
   }
-  if ($arch eq "all") {
-    # we add the .tlpobj into the .tlpobj directory
-    my $removetlpobjdir = 0;
-    if (! -d "$tlpobjdir") {
-      &mkpath("$tlpobjdir");
-      $removetlpobjdir = 1;
-    }
-    open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
-    $self->writeout(\*TMP);
-    close(TMP);
-    push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
+  # we add the .tlpobj into the .tlpobj directory
+  my $removetlpobjdir = 0;
+  if (! -d "$tlpobjdir") {
+    &mkpath("$tlpobjdir");
+    $removetlpobjdir = 1;
   }
+  open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
+  $self->writeout(\*TMP);
+  close(TMP);
+  push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
   if ($type eq "zip") {
     $containername .= ".zip";
       if ($^O =~ /MSWin32/) {
@@ -473,15 +580,14 @@ sub _make_container {
     }
   } @files;
   close ZIP;
-  if ($arch eq "all") {
-    # cleaning up
-    unlink("$tlpobjdir/$self->{'name'}.tlpobj");
-    rmdir("$tlpobjdir") if $removetlpobjdir;
-  }
+  # cleaning up
+  unlink("$tlpobjdir/$self->{'name'}.tlpobj");
+  rmdir("$tlpobjdir") if $removetlpobjdir;
   chdir($cwd);
   print "Done $containername\n" if ($::opt_debug);
 }
 
+
 sub is_arch_dependent {
   my $self = shift;
   if (keys %{$self->{'binfiles'}}) {
@@ -586,6 +692,24 @@ sub is_meta_package {
   return 0;
 }
 
+sub split_package {
+  my $self = shift;
+  my %binf = %{$self->binfiles};
+  my @retlist;
+  foreach $a (keys(%binf)) {
+    my $tlp = new TeXLive::TLPOBJ;
+    $tlp->name($self->name . ".$a");
+    $tlp->shortdesc("binary files of " . $self->name . " for $a");
+    $tlp->revision($self->revision);
+    $tlp->category($self->category);
+    $tlp->add_binfiles($a,@{$binf{$a}});
+    push @retlist, $tlp;
+  }
+  $self->clearbinfiles();
+  push @{$self->{'depends'}}, $self->name . ".ARCH";
+  return(@retlist);
+}
+
 
 # Helpers.
 # 
@@ -660,7 +784,7 @@ sub catalogue {
 }
 sub srcfiles {
   my $self = shift;
-  if (@_) { @{ $self->{'srcfiles'} } = @_ }
+  if (@_) { $self->{'srcfiles'} = [ @_ ] }
   return @{ $self->{'srcfiles'} };
 }
 sub srcsize {
@@ -668,6 +792,10 @@ sub srcsize {
   if (@_) { $self->{'srcsize'} = shift }
   return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 );
 }
+sub clearsrcfiles {
+  my $self = shift;
+  $self->{'srcfiles'} = [ ] ;
+}
 sub add_srcfiles {
   my ($self,@files) = @_;
   $self->add_files("src",@files);
@@ -678,9 +806,13 @@ sub remove_srcfiles {
 }
 sub docfiles {
   my $self = shift;
-  if (@_) { @{ $self->{'docfiles'} } = @_ }
+  if (@_) { $self->{'docfiles'} = [ @_ ] }
   return @{ $self->{'docfiles'} };
 }
+sub cleardocfiles {
+  my $self = shift;
+  $self->{'docfiles'} = [ ] ;
+}
 sub docsize {
   my $self = shift;
   if (@_) { $self->{'docsize'} = shift }
@@ -700,6 +832,10 @@ sub binfiles {
   if (@_) { $self->{'binfiles'} = \%newfiles }
   return $self->{'binfiles'};
 }
+sub clearbinfiles {
+  my $self = shift;
+  $self->{'binfiles'} = { };
+}
 sub binsize {
   my $self = shift;
   my %newsizes = @_;
@@ -722,9 +858,13 @@ sub remove_binfiles {
 }
 sub runfiles {
   my $self = shift;
-  if (@_) { @{ $self->{'runfiles'} } = @_ }
+  if (@_) { $self->{'runfiles'} = [ @_ ] }
   return @{ $self->{'runfiles'} };
 }
+sub clearrunfiles {
+  my $self = shift;
+  $self->{'runfiles'} = [ ] ;
+}
 sub runsize {
   my $self = shift;
   if (@_) { $self->{'runsize'} = shift }
@@ -740,12 +880,12 @@ sub remove_runfiles {
 }
 sub depends {
   my $self = shift;
-  if (@_) { @{ $self->{'depends'} } = @_ }
+  if (@_) { $self->{'depends'} = [ @_ ] }
   return @{ $self->{'depends'} };
 }
 sub executes {
   my $self = shift;
-  if (@_) { @{ $self->{'executes'} } = @_ }
+  if (@_) { $self->{'executes'} = [ @_ ] }
   return @{ $self->{'executes'} };
 }
 sub containerdir {
@@ -947,7 +1087,7 @@ debugging function for comparison with C<tpm>/C<tlps>, will go away.
 
 =item C<make_container($type,$instroot[, $destdir[, $containername[, $relative]]])>
 
-creates a container file of the arch B<independent> files in the C<TLPOBJ>
+creates a container file of the all files in the C<TLPOBJ>
 in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used).
 
 The C<$type> variable specifies the type of container to be used.
@@ -959,13 +1099,8 @@ where extension is either C<.zip> or C<.tar.lzma>, depending on the
 setting of C<$type>. If no C<$containername> is specified the package name
 is used.
 
-If the package contains C<"binfiles">, then container files for 
-all archs containing B<only> the binfiles are created, and 
-those container files name is C<$containername.$arch.$extension>
-
-All the arch independent container files B<also> contain the respective
-C<TLPOBJ> file in C<tlpkg/tlpobj/$name.tlpobj> so C<$containername.$extension> does
-contain this tlpobj file, while C<$containername.$arch.$extension> does NOT.
+All container files B<also> contain the respective
+C<TLPOBJ> file in C<tlpkg/tlpobj/$name.tlpobj>.
 
 The argument C<$instroot> specifies the root of the installation from
 which the files should be taken.
@@ -998,6 +1133,14 @@ adds information from a C<TeXCatalogue> object
 (currently license, version, url, and updates docfiles with details and
 languages tags if present in the Catalogue).
 
+=item C<split_package>
+
+splits off the binfiles of C<TLPOBJ> into new independent C<TLPOBJ> with
+the original name plus ".arch" for every arch for which binfiles are present.
+The original package is changed in two respects: the binfiles are removed
+(since they are now in the single name.arch packages), and an additional
+depend on "name.ARCH" is added. Note that the ARCH is a placeholder.
+
 =item C<is_arch_dependent>
 
 returns C<1> if there are C<binfiles>, otherwise C<0>.
@@ -1016,6 +1159,10 @@ architectures.
 Returns true if the package is a meta package as defined in TLConfig
 (Currently Collection and Scheme).
 
+=item C<clear_{src,run,doc,bin}files>
+
+Removes all the src/run/doc/binfiles from the C<TLPOBJ>.
+
 =item C<{add,remove}_{src,run,doc}files(@files)>
 
 adds or removes files to the respective list of files.