Move most of the stuff from tlpkg, tlmgr from branch to trunk

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

1 files changed, 183 insertions, 46 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 344b4a0d2b7..70c5cd67679 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -8,9 +8,8 @@
 package TeXLive::TLMedia;
 
 use TeXLive::TLConfig;
-use TeXLive::TLPostActions;
 use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
-                        merge_into debug ddebug info tlwarn);
+                        merge_into debug ddebug info tlwarn log);
 use TeXLive::TLPDB;
 
 sub new
@@ -42,7 +41,7 @@ sub new
     }
   }
   debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
-  my $tlpdb = TeXLive::TLPDB->new(root => "$location");
+  my $tlpdb = TeXLive::TLPDB->new(root => $location);
   return(undef) unless defined($tlpdb);
   my (@all_c, @std_c, @lang_c, @lang_doc_c);
   my (@schemes);
@@ -117,6 +116,7 @@ sub install_package {
       # even if opt_doc is false
       $real_opt_doc = 1;
     }
+    my $reloc = 1 if $tlpobj->relocated;
     my $container;
     my @installfiles;
     my $location = $self->location;
@@ -146,16 +146,17 @@ sub install_package {
     } elsif ($media eq 'CD') {
       if (-r "$location/$Archive/$pkg.zip") {
         $container = "$location/$Archive/$pkg.zip";
-      } elsif (-r "$location/$Archive/$pkg.tar.lzma") {
-        $container = "$location/$Archive/$pkg.tar.lzma";
+      } elsif (-r "$location/$Archive/$pkg.tar.xz") {
+        $container = "$location/$Archive/$pkg.tar.xz";
       } else {
-        tlwarn("Cannot find a package $pkg (.zip or .lzma) in $location/$Archive\n");
+        tlwarn("Cannot find a package $pkg (.zip or .xz) in $location/$Archive\n");
         next;
       }
     } 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')) {
@@ -164,21 +165,39 @@ sub install_package {
       # - src/doc files should be installed
       # (- the package is not already a split one (like .i386-linux))
       # the above test has been removed because it would mean that
-      #   texlive.infra.doc.tar.lzma
+      #   texlive.infra.doc.tar.xz
       # will never be installed, and we do already check that there
       # are at all src/doc files, which in split packages of the form 
       # foo.ARCH are not present. And if they are present, than that is fine,
-      # too (bin-foobar.win32.doc.tar.lzma)
+      # too (bin-foobar.win32.doc.tar.xz)
       # - there are actually src/doc files present
       if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
         my $srccontainer = $container;
-        $srccontainer =~ s/(\.tar\.lzma|\.zip)$/.source$1/;
-        $self->_install_package($srccontainer,\@installfiles,$totlpdb) || return(0);
+        $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+        $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb) 
+          || return(0);
       }
       if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
         my $doccontainer = $container;
-        $doccontainer =~ s/(\.tar\.lzma|\.zip)$/.doc$1/;
-        $self->_install_package($doccontainer,\@installfiles,$totlpdb) || return(0);
+        $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+        $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb) 
+          || return(0);
+      }
+      #
+      # if we installed from NET/CD and we got a relocatable container
+      # make sure that the stray texmf-dist/tlpkg directory is removed
+      # in USER MODE that should NOT be done because we keep the information
+      # there, but for now do it unconditionally
+      if ($tlpobj->relocated) {
+        my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
+        my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
+        my $tlpod = $tlpkgdir .  "/tlpobj";
+        TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
+        # we try to remove the tlpkg directory, that will succeed only
+        # if it is empty. So in normal installations it won't be, but
+        # if we are installing a relocated package it is texmf-dist/tlpkg
+        # which will be (hopefully) empty
+        rmdir($tlpkgdir) if (-d "$tlpkgdir");
       }
     }
     # we don't want to have wrong information in the tlpdb, so remove the
@@ -190,7 +209,7 @@ sub install_package {
       $tlpobj->clear_docfiles;
     }
     # we have to write out the tlpobj file since it is contained in the
-    # archives (.tar.lzma) but at DVD install time we don't have them
+    # archives (.tar.xz) but at DVD install time we don't have them
     my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
     mkdirhier( $tlpod );
     open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
@@ -204,10 +223,12 @@ sub install_package {
     merge_into(\%ret, $tlpobj->make_return_hash_from_executes("enable"));
     if (!$nopostinstall) {
       # do the postinstallation actions
-      if (defined($PostInstall{$pkg})) {
-        info("running post install action for $pkg\n");
-        &{$PostInstall{$pkg}}($totlpdb->root);
-      }
+      #
+      # Run the post installation code in the postaction tlpsrc entries
+      &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+        $totlpdb->option_file_assocs,
+        $totlpdb->option_desktop_integration,
+        $totlpdb->option_post_code);
     }
     return \%ret;
   }
@@ -219,17 +240,18 @@ sub install_package {
 # 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;
+  my $tempdir = "$target/temp";
 
   my @filelist = @$filelistref;
 
   # we assume that $::progs has been set up!
   my $wget = $::progs{'wget'};
-  my $lzmadec = $::progs{'lzmadec'};
-  if (!defined($wget) || !defined($lzmadec)) {
+  my $xzdec = $::progs{'xzdec'};
+  if (!defined($wget) || !defined($xzdec)) {
     tlwarn("_install_package: programs not set up properly, strange.\n");
     return(0);
   }
@@ -246,27 +268,31 @@ sub _install_package {
     }
     # we always assume that copy will work
     return(1);
-  } elsif ($what =~ m,\.tar(\.lzma)?$,) {
-    my $type = defined($1) ? "lzma" : "tar";
+  } elsif ($what =~ m,\.tar(\.xz)?$,) {
+    my $type = defined($1) ? "xz" : "tar";
       
+    $target .= "/$TeXLive::TLConfig::RelocTree" 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.lzma (or use the present
-    # one), lzmadec them, and then call tar
+    # in all other cases we create temp files .tar.xz (or use the present
+    # one), xzdec them, and then call tar
 
     my $fn = basename($what);
-    mkdirhier("$target/temp");
+    my $pkg = $fn;
+    $pkg =~ s/\.tar(\.xz)?$//;
+    mkdirhier("$tempdir");
     my $tarfile;
     my $remove_tarfile = 1;
-    if ($type eq "lzma") {
-      my $lzmafile = "$target/temp/$fn";
-      $tarfile  = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
-      my $lzmafile_quote = $lzmafile;
+    if ($type eq "xz") {
+      my $xzfile = "$tempdir/$fn";
+      $tarfile  = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
+      my $xzfile_quote = $xzfile;
       my $tarfile_quote = $tarfile;
       my $target_quote = $target;
       if (win32()) {
-        $lzmafile =~ s!/!\\!g;
-        $lzmafile_quote = "\"$lzmafile\"";
+        $xzfile =~ s!/!\\!g;
+        $xzfile_quote = "\"$xzfile\"";
         $tarfile =~ s!/!\\!g;
         $tarfile_quote = "\"$tarfile\"";
         $target =~ s!/!\\!g;
@@ -275,28 +301,28 @@ sub _install_package {
       if ($what =~ m,http://|ftp://,) {
         # we are installing from the NET
         # download the file and put it into temp
-        if (!download_file($what, $lzmafile) || (! -r $lzmafile)) {
+        if (!download_file($what, $xzfile) || (! -r $xzfile)) {
           tlwarn("Downloading \n");
           tlwarn("   $what\n");
           tlwarn("did not succeed, please retry.\n");
-          unlink($tarfile, $lzmafile);
+          unlink($tarfile, $xzfile);
           return(0);
         }
       } else {
         # we are installing from CD
         # copy it to temp
-        copy($what, "$target/temp");
+        copy($what, $tempdir);
       }
-      debug("un-lzmaing $lzmafile to $tarfile\n");
-      system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+      debug("un-xzing $xzfile to $tarfile\n");
+      system("$xzdec < $xzfile_quote > $tarfile_quote");
       if (! -f $tarfile) {
-        tlwarn("_install_package: Unpacking $lzmafile failed, please retry.\n");
-        unlink($tarfile, $lzmafile);
+        tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n");
+        unlink($tarfile, $xzfile);
         return(0);
       }
-      unlink($lzmafile);
+      unlink($xzfile);
     } else {
-      $tarfile = "$target/temp/$fn";
+      $tarfile = "$tempdir/$fn";
       if ($what =~ m,http://|ftp://,) {
         if (!download_file($what, $tarfile) || (! -r $tarfile)) {
           tlwarn("Downloading \n");
@@ -310,13 +336,125 @@ sub _install_package {
         $remove_tarfile = 0;
       }
     }
-    return TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
+    my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
+    # remove the $pkg.tlpobj, we recreate it anyway again
+    unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") 
+      if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
+    return $ret;
   } else {
     tlwarn("_install_package: Don't know how to install $what\n");
     return(0);
   }
 }
 
+#
+# remove_package removes a single package with all files (including the
+# # tlpobj files) and the entry from the tlpdb.
+sub remove_package {
+  my ($self, $pkg, $nopostinstall) = @_;
+  my $localtlpdb = $self->tlpdb;
+  my $tlp = $localtlpdb->get_package($pkg);
+  my %ret;
+  if (!defined($tlp)) {
+    tlwarn ("$pkg: package not present, cannot remove\n");
+  } else {
+    if ($pkg =~ m/^texlive\.infra/) {
+      log ("Not removing $pkg, it is essential!\n");
+      return;
+    }
+    # we have to chdir to $localtlpdb->root
+    my $Master = $localtlpdb->root;
+    chdir ($Master) || die "chdir($Master) failed: $!";
+    my @files = $tlp->all_files;
+    # also remove the .tlpobj file
+    push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+    # and the ones from src/doc splitting
+    if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
+      push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
+    }
+    if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+      push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+    }
+    #
+    # some packages might be relocated, thus having the RELOC prefix
+    # in user mode we just remove the prefix, in normal mode we
+    # replace it with texmf-dist
+    # since we don't have user mode 
+    if ($tlp->relocated) {
+      for (@files) {
+        s:^$RelocPrefix/:$RelocTree/:;
+      }
+    }
+    #
+    # we want to check that a file is only listed in one package, so
+    # in case that a file to be removed is listed in another package
+    # we will warn and *not* remove it
+    my %allfiles;
+    for my $p ($localtlpdb->list_packages) {
+      next if ($p eq $pkg); # we have to skip the to be removed package
+      for my $f ($localtlpdb->get_package($p)->all_files) {
+      	$allfiles{$f} = $p;
+      }
+    }
+    my @goodfiles = ();
+    my @badfiles = ();
+    for my $f (@files) {
+      # in usermode we have to add texmf-dist again for comparison
+      if (defined($allfiles{$f})) {
+        # this file should be removed but is mentioned somewhere, too
+        push @badfiles, $f;
+      } else {
+        push @goodfiles, $f;
+      }
+    }
+    if ($#badfiles >= 0) {
+      # warn the user
+      tlwarn("The following files should be removed due to the removal of $pkg,\n");
+      tlwarn("but are part of another package, too.\n");
+      for my $f (@badfiles) {
+        tlwarn(" $f - $allfiles{$f}\n");
+      }
+    }
+    #
+    # Run only the postaction code thing now since afterwards the
+    # files will be gone ...
+    if (!$nopostinstall) {
+      &TeXLive::TLUtils::do_postaction("remove", $tlp,
+        0, # option_file_assocs,
+        0, # option_desktop_integration,
+        $localtlpdb->option_post_code);
+    }
+    # 
+    # now do the removal
+    foreach my $entry (@goodfiles) {
+      unlink $entry;
+    }
+    tlwarn("MISSING REMOVAL OF EMPTY DIRECTORIES: sub removed_dirs needed!\n");
+    #my @removals = &removed_dirs (@goodfiles);
+    #foreach my $entry (@removals) {
+    #  rmdir $entry;
+    #}
+    $localtlpdb->remove_package($pkg);
+    merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
+    $ret{'mktexlsr'} = 1;
+    # should we save at each removal???
+    # advantage: the tlpdb actually reflects what is installed
+    # disadvantage: removing a collection calls the save routine several times
+    # still I consider it better that the tlpdb is in a consistent state
+    $localtlpdb->save;
+    #
+    # Run the post installation code in the postaction tlpsrc entries
+    # the postaction code part cannot be evaluated now since the
+    # files are already removed.
+    if (!$nopostinstall) {
+      &TeXLive::TLUtils::do_postaction("remove", $tlp,
+        $localtlpdb->option_file_assocs,
+        $localtlpdb->option_desktop_integration,
+        0);
+    }
+  }
+  return \%ret;
+}
 
 
 # member access functions
@@ -344,10 +482,9 @@ C<TeXLive::TLMedia> -- TeX Live Media module
 
   use TeXLive::TLMedia;
 
-  my $tlnet = TeXLive::TLMedia->new('NET');
-  my $tlneo = TeXLive::TLMedia->new('NET','http://www.ctan.org/mirror/tl/');
-  my $tlcd  = TeXLive::TLMedia->new('CD','/mnt/tl-cd/');
-  my $tldvd = TeXLive::TLMedia->new('DVD','/mnt/tl-dvd/');
+  my $tlneo = TeXLive::TLMedia->new('http://www.ctan.org/mirror/tl/');
+  my $tlcd  = TeXLive::TLMedia->new('/mnt/tl-cd/');
+  my $tldvd = TeXLive::TLMedia->new('/mnt/tl-dvd/');
 
 =head1 DESCRIPTION