too many changes, see email, basically tl.-package-manager work

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

1 files changed, 525 insertions, 0 deletions

diff --git a/Master/texmf/scripts/texlive/tl-package-manager.pl b/Master/texmf/scripts/texlive/tl-package-manager.pl
new file mode 100755
index 00000000000..ced4b7af94b
--- /dev/null
+++ b/Master/texmf/scripts/texlive/tl-package-manager.pl
@@ -0,0 +1,525 @@
+#!/usr/bin/env perl
+
+# $Id: tl-package-manager.pl 6381 2008-01-23 17:50:54Z preining $
+#
+# Copyright 2008 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# TODO:
+# - ordering or collections removal (see below for details)
+# - (?) removal does not remove created format files from TEXMFSYSVAR
+# - other features: dependency check?, ...?
+# - improve search function
+
+
+my $Master;
+
+BEGIN {
+  $^W = 1;
+  $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
+  chomp($Master);
+  unshift (@INC, "$Master/tlpkg");
+}
+
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLConfig;
+use TeXLive::TLMedia;
+use Cwd qw/abs_path/;
+use Getopt::Long;
+use Pod::Usage;
+$Getopt::Long::autoabbrev=0;
+use strict;
+
+
+# used variables
+# the TLMedia from which we install/update
+my $tlmediasrc;
+# the tlpdb of the install media
+my $tlpdb;
+# the local tlpdb
+my $localtlpdb;
+# a hash for saving the options saved into the local tlpdb
+my %options;
+# the location from where we install
+my $location;
+
+# option handling
+my $opt_location;
+my $opt_nodepends = 0;
+my $opt_help = 0;
+my $opt_debug = 0;
+my $opt_force = 0;
+my $opt_dry = 0;
+
+GetOptions("location=s" => \$opt_location,
+           "netarchive=s" => \$NetArchive,
+           "diskarchive=s" => \$DiskArchive,
+           "no-depends" => \$opt_nodepends,
+           "force" => \$opt_force,
+           "dry-run" => \$opt_dry,
+           "debug!", "h|help|?" => \$opt_help) or pod2usage(1);
+
+if ($^O=~/^MSWin(32|64)$/i) {
+  pod2usage(-exitstatus => 0, -verbose => 2, -noperldoc => 1) if $opt_help;
+} else {
+  pod2usage(-exitstatus => 0, -verbose => 2) if $opt_help;
+}
+
+my $action = shift;
+
+if ($opt_debug) {
+  $::LOGLEVELFILE = $::LOG_DDDEBUG;
+  $::LOGLEVELTERMINAL = $::LOG_DDDEBUG;
+}
+
+#
+# here starts the magic
+#
+$localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+die("cannot find tlpdb!") unless (defined($localtlpdb));
+
+# let cmd line options override the settings in localtlpdb
+my $loc = $localtlpdb->option_location;
+if (defined($loc)) {
+  $location = $loc;
+}
+if (defined($opt_location)) {
+  $location = $opt_location;
+}
+
+# in most cases we need to have access to the wget/tar/etc for win32
+# and TLPDB assumes that wget.exe is in the path, so for win32 we
+# add the tlpkg/installer to the path
+# That could be solved the way that TLPDB uses for win32 always the
+# wget from root/tlpkg/installer/. This would also allow to remove the
+# adding of the installer dir to the path in install-tl.bat
+if ($^O=~/^MSWin(32|64)$/i) {
+  $ENV{'PATH'} = "$Master/tlpkg/installer;$ENV{'PATH'}";
+}
+
+my $ret = 0;
+
+if ($action =~ m/^install$/i) {
+  # initialize the TLMedia from $location
+  $tlmediasrc = TeXLive::TLMedia->new($location);
+  foreach my $pkg (@ARGV) {
+    if ($opt_dry) {
+      print "Installing $pkg\n";
+    } else {
+      $ret |= $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends);
+    }
+  }
+} elsif ($action =~ m/^update$/i) {
+  # initialize the TLMedia from $location
+  $tlmediasrc = TeXLive::TLMedia->new($location);
+  my $mediatlpdb = $tlmediasrc->tlpdb;
+  foreach my $pkg ($localtlpdb->list_packages) {
+    next if ($pkg =~ m/^00texlive/);
+    my $tlp = $localtlpdb->get_package($pkg);
+    my $rev = $tlp->revision;
+    my $mediatlp = $mediatlpdb->get_package($pkg);
+    if (!defined($mediatlp)) {
+      print "$pkg cannot be found in $location\n";
+      next;
+    }
+    my $mediarev = $mediatlp->revision;
+    if ($rev < $mediarev) {
+      if ($opt_dry) {
+        print "Installing $pkg\n";
+      } else {
+        $ret |= $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends);
+      }
+    } elsif ($rev > $mediarev) {
+      print "revision in $location is less then local revision, not updating!\n";
+      next;
+    }
+  }
+} elsif ($action =~ m/^(global)?search$/i) {
+  my $r = shift;
+  my $ret = "";
+  my $tlpdb;
+  if ($action =~ m/^globalsearch$/i) {
+    my $tlmediasrc =  TeXLive::TLMedia->new($location);
+    $tlpdb = $tlmediasrc->tlpdb;
+  } else {
+    $tlpdb = $localtlpdb;
+  }
+  foreach my $pkg ($tlpdb->list_packages) {
+    next if ($pkg =~ m/\./);
+    my $t = $tlpdb->get_package($pkg)->shortdesc;
+    $t |= "";
+    if (($pkg =~ m/$r/) || ($t =~ m/$r/)) { 
+      $ret .= " $pkg - $t\n";
+    }
+  }
+  print "$ret";
+  exit(0);
+} elsif ($action =~ m/^remove$/i) {
+  # we do the following:
+  # - (not implemented) order collections such that those depending on
+  #   other collections are first removed, and then those which only 
+  #   depend on packages. Otherwise 
+  #     remove collection-latex collection-latexrecommended
+  #   will not succeed
+  # - first loop over all cmd line args and consider only the collections
+  # - for each to be removed collection:
+  #   . check that no other collections/scheme asks for that collection
+  #   . remove the collection
+  #   . remove all dependencies
+  # - for each normal package not already removed (via the above)
+  #   . check that no collection/scheme still depends on this package
+  #   . remove the package
+  #
+  my %already_removed;
+  my @more_removal;
+  foreach my $pkg (@ARGV) {
+    my $tlp = $localtlpdb->get_package($pkg);
+    next if defined($already_removed{$pkg});
+    if (!defined($tlp)) {
+      print "Package $pkg not present, cannot remove it!\n";
+    } else {
+      # in the first round we only remove collections, nothing else
+      # but removing collections will remove all dependencies, too
+      # save the information of which packages have already been removed
+      # into %already_removed.
+      if ($tlp->category eq "Collection") {
+        # for collections we also remove all dependencies which are
+        # not Collections or Schemes
+        my $foo;
+        if ($opt_dry) {
+          print "Removing $pkg\n";
+          # we need to set $foo to something positive otherwise
+          # the rest will not be run in dry_run mode
+          $foo = 0x0001;
+        } else {
+          $foo = &remove_package($pkg, $localtlpdb, $opt_force);
+        }
+        if ($foo) {
+          # removal was successful, so the return is at least 0x0001 mktexlsr
+          # remove dependencies, too
+          $ret |= $foo;
+          $already_removed{$pkg} = 1;
+          if (!$opt_nodepends) {
+            foreach my $d ($tlp->depends) {
+              my $tlpdd = $localtlpdb->get_package($d);
+              if (defined($tlpdd)) {
+                if ($tlpdd->category !~ m/$MetaCategoriesRegexp/) {
+                  if ($opt_dry) {
+                    print "Removing $d\n";
+                  } else {
+                    $ret |= &remove_package($d, $localtlpdb, $opt_force);
+                  }
+                  $already_removed{$d} = 1;
+                }
+              }
+            }
+          }
+        }
+      } else {
+        # save all the other packages into the @more_removal list to
+        # be removed at the second state. Note that if a package has
+        # already been removed due to a removal of a collection
+        # it will be marked as such in %already_removed and not tried again
+        push @more_removal, $pkg;
+      }
+    }
+  }
+  foreach my $pkg (@more_removal) {
+    if (!defined($already_removed{$pkg})) {
+      if ($opt_dry) {
+        print "Removing $pkg\n";
+      } else {
+        $ret |= &remove_package($pkg, $localtlpdb, $opt_force);
+      }
+    }
+  }
+  if (!$opt_dry) {
+    $localtlpdb->save;
+  }
+} else {
+  die "Unknown action: $action";
+}
+
+if ($opt_dry) {
+  # stop here, don't do any postinstall actions
+  exit(0);
+}
+
+if ($ret & 0x0001) {
+  print "running mktexlsr\n";
+  system("mktexlsr");
+}
+my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`;
+chomp $TEXMFSYSVAR;
+my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`;
+chomp $TEXMFLOCAL;
+if ($ret & 0x0010) {
+  print "regenerating updmap.cfg\n";
+  TeXLive::TLUtils::create_updmap ($localtlpdb,
+    "$TEXMFSYSVAR/web2c/updmap.cfg",
+    "$TEXMFLOCAL/web2c/updmap-local.cfg");
+  # system("texconfig-sys", "generate", "updmap");
+  print "running updmap-sys\n";
+  system("updmap-sys");
+}
+if ($ret & 0x0100) {
+  print "regenerating fmtutil.cnf\n";
+  TeXLive::TLUtils::create_fmtutil($localtlpdb,
+    "$TEXMFSYSVAR/web2c/fmtutil.cnf",
+    "$TEXMFLOCAL/web2c/fmtutil-local.cnf");
+  # system("texconfig-sys", "generate", "fmtutil");
+  print "running fmtutil-sys --missing\n";
+  system("fmtutil-sys", "--missing");
+}
+if ($ret & 0x1000) {
+  print "regenerating language.dat\n";
+  TeXLive::TLUtils::create_language($localtlpdb,
+    "$TEXMFSYSVAR/tex/generic/config/language.dat",
+    "$TEXMFLOCAL/tex/generic/config/language-local.dat");
+  # system("texconfig-sys", "generate", "language");
+  print "running fmtutil-sys --byhyphen language.dat\n";
+  system("fmtutil-sys", "--byhyphen", "language.dat");
+}
+
+exit(0);
+
+#
+# remove_package removes a single package with all files (including the
+# tlpobj files) and the entry from the tlpdb.
+#
+sub remove_package {
+  my ($pkg, $localtlpdb, $force) = @_;
+  my $tlp = $localtlpdb->get_package($pkg);
+  my $ret = 0;
+  if (!defined($tlp)) {
+    print "Package $pkg not present, cannot remove it!\n";
+  } else {
+    if (!$force) {
+      # do some checking
+      my @needed = $localtlpdb->needed_by($pkg);
+      if (@needed) {
+        print "Not removing $pkg, is referenced in @needed!\n";
+        return $ret;
+      }
+    }
+    print "remove package $pkg\n";
+    # 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.src.tlpobj") { 
+      push @files, "tlpkg/tlpobj/$pkg.src.tlpobj";
+    }
+    if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") { 
+      push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+    }
+    my @removals = &removed_dirs (@files);
+    foreach my $entry (@files) {
+      unlink $entry;
+    }
+    foreach my $entry (@removals) {
+      rmdir $entry;
+    }
+    $localtlpdb->remove_package($pkg);
+    $ret |= 0x0001; # call mktexlsr
+    foreach my $e ($tlp->executes) {
+      if ($e =~ m/^add/) {
+        $ret |= 0x0010;
+      } elsif ($e =~ m/^BuildFormat/) {
+        $ret |= 0x0100;
+      } elsif ($e =~ m/^BuildLanguageDat/) {
+        $ret |= 0x1000;
+      } else {
+        warn("Unknown execute $e in $pkg");
+      }
+    }
+    # remove those bin dependencies .ARCH
+    foreach my $d ($tlp->depends) {
+      if ($d eq "$pkg.ARCH") {
+        foreach my $a ($localtlpdb->available_architectures) {
+          $ret |= &remove_package("$pkg.$a", $localtlpdb, $force);
+        }
+      }
+    }
+    # 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;
+  }
+  return $ret;
+}
+
+
+# 
+# return all the directories from which all content will be removed
+#
+# idea:
+# - create a hashes by_dir listing all files that should be removed
+#   by directory, i.e., key = dir, value is list of files
+# - for each of the dirs (keys of by_dir and ordered deepest first) 
+#   check that all actually contained files are removed
+#   and all the contained dirs are in the removal list. If this is the
+#   case put that directory into the removal list
+# - return this removal list
+#
+sub removed_dirs
+{
+  my (@files) = @_;
+  my %removed_dirs;
+  my %by_dir;
+  
+  # construct hash of all directories mentioned, values are lists of the
+  # files/dirs in that directory.
+  for my $f (@files) {
+    my $abs_f = abs_path ($f);
+    die ("oops, no abs_path($f) from " . `pwd`) unless $abs_f;
+    (my $d = $abs_f) =~ s,/[^/]*$,,;
+    my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+    push (@a, $abs_f);
+    $by_dir{$d} = \@a;
+  }
+  
+  # for each of our directories, see if we are removing everything in
+  # the directory.  if so, return the directory; else return the
+  # individual files.
+  for my $d (reverse sort keys %by_dir) {
+    opendir (DIR, $d) || die "opendir($d) failed: $!";
+    my @dirents = readdir (DIR);
+    closedir (DIR) || warn "closedir($d) failed: $!";
+   
+    # initialize test hash with all the files we saw in this dir.
+    # (These idioms are due to "Finding Elements in One Array and Not
+    # Another" in the Perl Cookbook.)
+    my %seen;
+    my @rmfiles = @{$by_dir{$d}};
+    @seen{@rmfiles} = ();
+
+    # see if everything is the same.
+    my $cleandir = 1;
+    for my $dirent (@dirents) {
+      next if $dirent =~ /^\.(\.|svn)?$/;  # ignore . .. .svn
+      my $item = "$d/$dirent";  # prepend directory for comparison
+      if ( 
+           ((-d $item) && (defined($removed_dirs{$item})))
+           ||
+           (exists $seen{$item})
+         ) {
+        # do nothing 
+      } else {
+        $cleandir = 0;
+        last;
+      }
+    }
+    if ($cleandir) {
+      $removed_dirs{$d} = 1;
+    }
+  }
+  return keys %removed_dirs;
+}
+
+__END__
+
+=head1 NAME
+
+tl-package-manager - the TeX Live Package Manager
+
+=head1 SYNOPSIS
+
+tl-package-manager ACTION [OPTION] ... [PACKAGE] ...
+
+=head1 ACTION
+
+=over 8
+
+=item B<install>
+
+Install all packages given on the cmdline. By default this installs all
+dependencies, too. See below for the option B<-no-depends>.
+
+=item B<update>
+
+Update all packages if newer ones are available
+
+=item B<remove>
+
+Remove all packages given on the cmdline. Removing a collection will
+remove all dependencies, too, unless with option B<-no-depends>.
+
+Removing a package which is referenced as a dependency in another 
+collection or scheme will not succeed unless the B<-force> option is given.
+
+=item B<search>
+
+Search the names and short descriptions of all locally installed packages
+for the given argument (interpreted as regexp).
+
+=item B<globalsearch>
+
+Search the names and short descriptions of all packages available on
+the install media.
+
+=back
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-location> I<location>
+
+Overrides the location as found in the tlpdb of the installation. Specifies
+the location from which packages should be installed or updated.
+
+=item B<-no-depends>
+
+Do not install dependencies. If this option is not given installing
+a package will check that all dependencies of this package are fulfilled.
+
+=item B<-force>
+
+When removing a package or collection would invalidate a dependency
+of another collection/scheme, the package will not be removed and
+a warning issued. With this options the package will be removed
+unconditionally. Use with care.
+
+=item B<-dry-run>
+
+Do not actually install or remove anything, just echo what would be
+done.
+
+=item B<-netarchive> I<dir>
+
+Overrides the default settings for netarchive. Should be used with care.
+
+=item B<-diskarchive> I<dir>
+
+Overrides the default settings for diskarchive. Should be used with care.
+
+=back
+
+The standard options C<-help/-h/-?> and C<-debug> are also accepted.
+
+=head1 DESCRIPTION
+
+The B<tl-package-manager> allows to install and update packages after
+an initial installation.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #