add a patch allowing relocatable packages

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

1 files changed, 324 insertions, 0 deletions

diff --git a/Master/tlpkg/etc/allow_packages_to_be_relocatable.patch b/Master/tlpkg/etc/allow_packages_to_be_relocatable.patch
new file mode 100644
index 00000000000..b0b1a296984
--- /dev/null
+++ b/Master/tlpkg/etc/allow_packages_to_be_relocatable.patch
@@ -0,0 +1,324 @@
+Index: bin/tl-update-containers
+===================================================================
+--- bin/tl-update-containers	(revision 12901)
++++ bin/tl-update-containers	(working copy)
+@@ -43,6 +43,7 @@
+   "location=s"  => \$opt_location, 
+   "no-setup"    => \$opt_nosetup,
+   "recreate"    => \$opt_recreate,
++  "relative"    => \$opt_relative,
+   "version"	=> \$opt_version,
+   "help|?"      => \$opt_help) or pod2usage(1);
+ 
+@@ -235,14 +236,24 @@
+     debug("updating $pkg containers ...\n");
+     # we have to make a copy otherwise the src/doc files in the original
+     # tlpobj are removed, and thus also in the tlpdb to be saved!!!
++
+     my $objcopy = $obj->copy;
++
++    # if we try to create relative containers we check the package 
++    # for residing only in texmf-dist, and being relocatable
++    # TLPOBJ->common_texmf_tree returns the string of the
++    # common temxf tree or undefined, so we can use it in &&
++    my $ctt = $objcopy->common_texmf_tree;
++    my $do_relative = $opt_relative &&          # user option
++                      $ctt &&                   # see above
++                      ($ctt eq "texmf-dist");   # only for texmf-dist
+     if ($srcsplit) {
+       if (!$opt_dry) {
+         my $objsrc = $obj->srcfiles_package;
+         $objcopy->clear_srcfiles;
+         if ($objsrc) {
+           my ($s,$m) = $objsrc->make_container($type, $Master, $opt_containerdir,
+-                                              "$pkg.source", $opt_relative);
++                                              "$pkg.source", $do_relative);
+           if ($s > 0) {
+             # something was created 
+             # important, we have to add it to the original $obj
+@@ -266,7 +277,7 @@
+         $objcopy->clear_docfiles;
+         if ($objdoc) {
+           my ($s,$m) = $objdoc->make_container($type, $Master,
+-                                 $opt_containerdir, "$pkg.doc", $opt_relative);
++                                 $opt_containerdir, "$pkg.doc", $do_relative);
+           if ($s > 0) {
+             # something was created
+             $obj->doccontainersize($s);
+@@ -285,7 +296,7 @@
+     }
+     if (!$opt_dry) {
+       my ($s,$m) = $objcopy->make_container($type, $Master, $opt_containerdir,
+-                                            $pkg, $opt_relative);
++                                            $pkg, $do_relative);
+       if ($s > 0) {
+         $obj->containersize($s);
+       }
+@@ -293,6 +304,8 @@
+         $obj->containermd5($m);
+       }
+     }
++    # if the container has been build relocatable we save that information
++    $obj->relocated($do_relative);
+     # add the updated (or new) TLPOBJ to NET TLPDB
+     # that way the other container sizes are not destroyed
+     $nettlpdb->add_tlpobj($obj) unless $opt_dry;
+Index: TeXLive/TLPOBJ.pm
+===================================================================
+--- TeXLive/TLPOBJ.pm	(revision 12901)
++++ TeXLive/TLPOBJ.pm	(working copy)
+@@ -22,6 +22,7 @@
+     shortdesc   => $params{'shortdesc'},
+     longdesc    => $params{'longdesc'},
+     catalogue   => $params{'catalogue'},
++    relocated   => $params{'relocated'},
+     runfiles    => defined($params{'runfiles'}) ? $params{'runfiles'} : [],
+     runsize   => $params{'runsize'},
+     srcfiles    => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [],
+@@ -165,6 +166,10 @@
+         $self->{'category'} = "$1";
+         $lastcmd = "category";
+         next;
++      } elsif ($line =~ /^relocated\s+([01])\s*/o) {
++        $self->relocated("$1");
++        $lastcmd = "relocated";
++        next;
+       } elsif ($line =~ /^revision\s+(.*)\s*/o) {
+         $self->{'revision'} = "$1";
+         $lastcmd = "revision";
+@@ -305,6 +310,7 @@
+   defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n";
+   defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n";
+   defined($self->{'license'}) && print $fd "license $self->{'license'}\n";
++  defined($self->{'relocated'}) && print $fd "relocated 1\n";
+   # ugly hack to get rid of use FileHandle; see man perlform
+   #format_name $fd "multilineformat";
+   select((select($fd),$~ = "multilineformat")[0]);
+@@ -432,6 +438,22 @@
+   }
+ }
+ 
++sub common_texmf_tree {
++  my $self = shift;
++  my $tltree;
++  my @files = $self->all_files;
++  foreach ($self->all_files) {
++    my $tmp;
++    ($tmp) = split m@/@;
++    if (defined($tltree) && ($tltree ne $tmp)) {
++      return;
++    } else {
++      $tltree = $tmp;
++    }
++  }
++  return $tltree;
++}
++
+ 
+ sub make_container {
+   my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
+@@ -441,30 +463,18 @@
+   if (!defined($containername)) {
+     $containername = $self->name;
+   }
+-  my @files = ();
++  my @files = $self->all_files;
+   my $compresscmd;
+   my $tlpobjdir = "$InfraLocation/tlpobj";
+-  my %binf = %{$self->{'binfiles'}};
+-  foreach (keys %binf) {
+-    push @files, @{$binf{$_}};
+-  }
+-  push @files, $self->runfiles;
+-  push @files, $self->docfiles;
+-  push @files, $self->srcfiles;
+   @files = TeXLive::TLUtils::sort_uniq(@files);
+   # 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 ("$0: package $containername spans multiple trees, "
+-             . "relative generation not allowed");
+-      } else {
+-        $tltree = $tmp;
+-      }
++    $tltree = $self->common_texmf_tree;
++    if (!defined($tltree)) {
++      die ("$0: package $containername spans multiple trees, "
++           . "relative generation not allowed");
+     }
+     my @nf;
+     map { s@^$tltree/@@ ; push @nf, $_; } @files;
+@@ -895,6 +905,11 @@
+   if (@_) { $self->{'revision'} = shift }
+   return $self->{'revision'};
+ }
++sub relocated {
++  my $self = shift;
++  if (@_) { $self->{'relocated'} = shift }
++  return ($self->{'relocated'} ? 1 : 0);
++}
+ sub catalogue {
+   my $self = shift;
+   if (@_) { $self->{'catalogue'} = shift }
+@@ -1089,9 +1104,11 @@
+ only differences are that the various C<*pattern> keys are invalid, and
+ instead there are the respective C<*files> keys described below. Furthermore
+ some more I<keys> is allowed: C<revision> which specifies the maximum of
+-all last changed revision of files contained in the package, and anything
++all last changed revision of files contained in the package, anything
+ starting with C<catalogue-> specifying information coming from the
+-TeX Catalogue.
++TeX Catalogue, and C<relocated> taking either 0 or 1 indicating that
++this packages has been relocated, i.e., in the containers the 
++initial C<texmf-dist> directory has been stripped off.
+ 
+ All these keys have in common that they are followed by a list of files
+ I<indented> by one space. They differ only in the first line itself
+@@ -1264,6 +1281,12 @@
+ 
+ debugging function for comparison with C<tpm>/C<tlps>, will go away.
+ 
++=item C<common_texmf_tree>
++
++if all files of the package are from the same texmf tree, this tree 
++is returned, otherwise an undefined value. That is also a check
++whether a package is relocatable.
++
+ =item C<make_container($type,$instroot[, $destdir[, $containername[, $relative]]])>
+ 
+ creates a container file of the all files in the C<TLPOBJ>
+Index: TeXLive/TLMedia.pm
+===================================================================
+--- TeXLive/TLMedia.pm	(revision 12901)
++++ TeXLive/TLMedia.pm	(working copy)
+@@ -117,6 +117,7 @@
+       # even if opt_doc is false
+       $real_opt_doc = 1;
+     }
++    my $reloc = $tlpobj->relocated;
+     my $container;
+     my @installfiles;
+     my $location = $self->location;
+@@ -155,7 +156,7 @@
+     } elsif (&media eq 'NET') {
+       $container = "$location/$Archive/$pkg.$DefaultContainerExtension";
+     }
+-    $self->_install_package($container,\@installfiles,$totlpdb) || return(0);
++    $self->_install_package($container,$reloc,\@installfiles,$totlpdb) || return(0);
+     # if we are installing from CD or NET we have to fetch the respective
+     # source and doc packages $pkg.source and $pkg.doc and install them, too
+     if (($media eq 'NET') || ($media eq 'CD')) {
+@@ -173,12 +174,12 @@
+       if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
+         my $srccontainer = $container;
+         $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+-        $self->_install_package($srccontainer,\@installfiles,$totlpdb) || return(0);
++        $self->_install_package($srccontainer,$reloc,\@installfiles,$totlpdb) || return(0);
+       }
+       if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
+         my $doccontainer = $container;
+         $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+-        $self->_install_package($doccontainer,\@installfiles,$totlpdb) || return(0);
++        $self->_install_package($doccontainer,$reloc,\@installfiles,$totlpdb) || return(0);
+       }
+     }
+     # we don't want to have wrong information in the tlpdb, so remove the
+@@ -225,7 +226,7 @@
+ # returns 1 on success and 0 on error
+ #
+ sub _install_package {
+-  my ($self, $what, $filelistref, $totlpdb) = @_;
++  my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
+ 
+   my $media = $self->media;
+   my $target = $totlpdb->root;
+@@ -255,6 +256,9 @@
+   } elsif ($what =~ m,\.tar(\.xz)?$,) {
+     my $type = defined($1) ? "xz" : "tar";
+       
++    # if we are working on an relocated package we adjust the target
++    $target .= "/texmf-dist" if $reloc;
++
+     # this is the case when we install from CD or the NET, or a backup
+     #
+     # in all other cases we create temp files .tar.xz (or use the present
+Index: TeXLive/TLUtils.pm
+===================================================================
+--- TeXLive/TLUtils.pm	(revision 12901)
++++ TeXLive/TLUtils.pm	(working copy)
+@@ -950,6 +950,7 @@
+   my $starttime = time();
+   foreach my $package (@packs) {
+     my $tlpobj = $tlpobjs{$package};
++    my $reloc = $tlpobj->relocated;
+     $n++;
+     my $remtime = "??:??";
+     my $tottime = "??:??";
+@@ -1016,7 +1017,7 @@
+     } elsif ($media eq 'NET') {
+       $container = "$root/$Archive/$package.$DefaultContainerExtension";
+     }
+-    if (!install_package($container, $tlpobj->containersize, 
++    if (!install_package($container, $reloc, $tlpobj->containersize, 
+                          $tlpobj->containermd5, \@installfiles, 
+                          $totlpdb->root, $vars{'this_platform'})) {
+       # we already warn in install_package that something bad happened,
+@@ -1038,7 +1039,7 @@
+       if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
+         my $srccontainer = $container;
+         $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+-        if (!install_package($srccontainer, $tlpobj->srccontainersize,
++        if (!install_package($srccontainer, $reloc, $tlpobj->srccontainersize,
+                              $tlpobj->srccontainermd5, \@installfiles,
+                              $totlpdb->root, $vars{'this_platform'})) {
+           return 0;
+@@ -1047,7 +1048,7 @@
+       if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
+         my $doccontainer = $container;
+         $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+-        if (!install_package($doccontainer,
++        if (!install_package($doccontainer, $reloc,
+                              $tlpobj->doccontainersize,
+                              $tlpobj->doccontainermd5, \@installfiles,
+                              $totlpdb->root, $vars{'this_platform'})) {
+@@ -1084,7 +1085,7 @@
+ }
+ 
+ 
+-=item C<install_package($what, $size, $md5, $filelistref, $target, $platform)>
++=item C<install_package($what, $reloc, $size, $md5, $filelistref, $target, $platform)>
+ 
+ This function installs the files given in @$filelistref from C<$what>
+ into C<$target>.
+@@ -1107,12 +1108,15 @@
+ In both of these cases currently the list C<$@filelistref> currently
+ is not taken into account (should be fixed!).
+ 
++if C<$reloc> is true the container (NET or CD mode) is packaged in a way
++that the initial texmf-dist is missing.
++
+ Returns 1 on success and 0 on error.
+ 
+ =cut
+ 
+ sub install_package {
+-  my ($what, $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
++  my ($what, $reloc,  $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
+ 
+   my @filelist = @$filelistref;
+ 
+@@ -1139,6 +1143,9 @@
+     # in all other cases we create temp files .tar.xz (or use the present
+     # one), xzdec them, and then call tar
+ 
++    # if we are unpacking a relocated container we adjust the target
++    $target .= "/texmf-dist" if $reloc;
++
+     my $fn = basename($what);
+     mkdirhier("$target/temp");
+     my $xzfile = "$target/temp/$fn";