sub main, to enable use as library

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

1 files changed, 206 insertions, 181 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 35ad8115d2b..a441a542f5d 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -26,20 +26,39 @@ $datrev =~ s/ \(.*$//;
 $tlmgrrevision .= " ($datrev)";
 
 our $Master;
+our $ismain;
+our $loadmediasrcerror;
+our $packagelogfile;
+our $packagelogged;
 
 BEGIN {
   $^W = 1;
+  $ismain = (__FILE__ eq $0);
+  # WARNING
+  # The only use anticipated for tlmgr.pl as library for the 2009 release
+  # is the Windows w32client prototype script.
+  # Unix-specific problems with use as library will probably go undetected.
+
   # make subprograms (including kpsewhich) have the right path:
   my ($bindir, $kpsewhichname);
   if ($^O =~ /^MSWin/i) {
-    # on win32 $0 points directly to tlmgr.pl; it can be relative
-    $Master = "$0/../../../..";
+    # on win32 $0 and __FILE__ point directly to tlmgr.pl; they can be relative
+    $Master = __FILE__;
+    $Master = "$Master/../../../..";
     $bindir = "$Master/bin/win32";
     $kpsewhichname = "kpsewhich.exe";
+    # path already set by wrapper batchfile
   } else {
-    $bindir = $0;
-    $bindir =~ s,/*[^/]*$,,;
-    $Master = "$bindir/../..";
+    $Master = __FILE__;
+    $Master =~ s,/*[^/]*$,,;
+    if ($ismain) {
+      $bindir = $Master;
+      $Master = "$Master/../..";
+    } else {
+      # for the time being, this code will not be used or tested
+      $Master = "$Master/../../..";
+      # no code yet for $bindir; would have to detect platform
+    }
     # make subprograms (including kpsewhich) have the right path:
     $ENV{"PATH"} = "$bindir:$ENV{PATH}";
     $kpsewhichname = "kpsewhich";
@@ -80,7 +99,6 @@ our $tlmediatlpdb;
 our $location;     # location from which the new packages come
 our $localtlmedia; # local installation which we are munging
 our $localtlpdb;   # local installation which we are munging
-my %options;       # TL options from local tlpdb
 
 # flags for machine-readable form
 our $FLAG_REMOVE = "d";
@@ -93,93 +111,196 @@ our $FLAG_AUTOINSTALL = "a";
 $::gui_mode = 0;
 $::machinereadable = 0;
 
-my %globaloptions = (
-  "gui" => 1,
-  "gui-lang" => "=s",
-  "location" => "=s",
-  "machine-readable" => 1,
-  "package-logfiles" => "=s",
-  "pause" => 1,
-  "version" => 1,
-  "help|h|?" => 1);
-
-my %actionoptions = (
-  "remove"   =>  { "no-depends" => 1,
-                   "no-depends-at-all" => 1,
-                   "force" => 1,
-                   "dry-run|n" => 1 },
-  "show"     =>  { "list" => 1 },
-  "search"   =>  { "global" => 1,
-                   "file" => 1 },
-  "restore"  =>  { "backupdir" => "=s",
-                   "dry-run|n" => 1,
-                   "force" => 1 },
-  "backup"   =>  { "backupdir" => "=s",
-                   "clean" => ":-99",
-                   "all" => 1,
-                   "dry-run|n" => 1 },
-  "update"   =>  { "no-depends" => 1,
-                   "no-depends-at-all" => 1,
-                   "all" => 1,
-                   "list" => 1,
-                   "no-remove" => 1,
-                   "force" => 1,
-                   "backupdir" => "=s",
-                   "backup" => 1,
-                   "dry-run|n" => 1 },
-  "paper"    =>  { "list" => 1 },
-  "install"  =>  { "no-depends" => 1,
-                   "no-depends-at-all" => 1,
-                   "reinstall" => 1,
-                   "force" => 1,
-                   "dry-run|n" => 1 },
-  "arch"     =>  { "dry-run|n" => 1 },
-  "generate" =>  { "localcfg" => "=s",
-                   "dest" => "=s" },
-  "postaction" => {"w32mode" => "=s",
-                   "all" => 1,
-                   "fileassocmode" => "=i" },
-  "uninstall"=>  { "force" => 1 },
-  "check"    =>  { "use-svn" => 1 },
-  "recreate-tlpdb" => { "arch" => "=s" }
-  );
-
-my %optarg;
-for my $k (keys %globaloptions) {
-  if ($globaloptions{$k} eq "1") {
-    $optarg{$k} = 1;
-  } else {
-    $optarg{"$k" . $globaloptions{$k}} = 1;
-  }
-}
-for my $v (values %actionoptions) {
-  for my $k (keys %$v) {
-    if ($v->{$k} eq "1") {
+our %opts;
+
+main() if $ismain;
+
+sub main {
+  my %options;       # TL options from local tlpdb
+
+  my %globaloptions = (
+    "gui" => 1,
+    "gui-lang" => "=s",
+    "location" => "=s",
+    "machine-readable" => 1,
+    "package-logfiles" => "=s",
+    "pause" => 1,
+    "version" => 1,
+    "help|h|?" => 1);
+
+  my %actionoptions = (
+    "remove"   =>  { "no-depends" => 1,
+                     "no-depends-at-all" => 1,
+                     "force" => 1,
+                     "dry-run|n" => 1 },
+    "show"     =>  { "list" => 1 },
+    "search"   =>  { "global" => 1,
+                     "file" => 1 },
+    "restore"  =>  { "backupdir" => "=s",
+                     "dry-run|n" => 1,
+                     "force" => 1 },
+    "backup"   =>  { "backupdir" => "=s",
+                     "clean" => ":-99",
+                     "all" => 1,
+                     "dry-run|n" => 1 },
+    "update"   =>  { "no-depends" => 1,
+                     "no-depends-at-all" => 1,
+                     "all" => 1,
+                     "list" => 1,
+                     "no-remove" => 1,
+                     "force" => 1,
+                     "backupdir" => "=s",
+                     "backup" => 1,
+                     "dry-run|n" => 1 },
+    "paper"    =>  { "list" => 1 },
+    "install"  =>  { "no-depends" => 1,
+                     "no-depends-at-all" => 1,
+                     "reinstall" => 1,
+                     "force" => 1,
+                     "dry-run|n" => 1 },
+    "arch"     =>  { "dry-run|n" => 1 },
+    "generate" =>  { "localcfg" => "=s",
+                     "dest" => "=s" },
+    "postaction" => {"w32mode" => "=s",
+                     "all" => 1,
+                     "fileassocmode" => "=i" },
+    "uninstall"=>  { "force" => 1 },
+    "check"    =>  { "use-svn" => 1 },
+    "recreate-tlpdb" => { "arch" => "=s" }
+    );
+
+  my %optarg;
+  for my $k (keys %globaloptions) {
+    if ($globaloptions{$k} eq "1") {
       $optarg{$k} = 1;
     } else {
-      $optarg{"$k" . $v->{$k}} = 1;
+      $optarg{"$k" . $globaloptions{$k}} = 1;
     }
   }
-}
-TeXLive::TLUtils::process_logging_options();
+  for my $v (values %actionoptions) {
+    for my $k (keys %$v) {
+      if ($v->{$k} eq "1") {
+        $optarg{$k} = 1;
+      } else {
+        $optarg{"$k" . $v->{$k}} = 1;
+      }
+    }
+  }
+  TeXLive::TLUtils::process_logging_options();
 
-our %opts;
+  GetOptions(\%opts, keys(%optarg)) or pod2usage(2);
 
-GetOptions(\%opts, keys(%optarg)) or pod2usage(2);
+  $::machinereadable = $opts{"machine-readable"}
+    if (defined($opts{"machine-readable"}));
 
-$::machinereadable = $opts{"machine-readable"}
-  if (defined($opts{"machine-readable"}));
+  my $action = shift @ARGV;
+  if (!defined($action)) {
+    $action = $opts{"gui"} ? "gui" : "";
+  }
 
-my $action = shift;
-if (!defined($action)) {
-  $action = $opts{"gui"} ? "gui" : "";
-}
+  ddebug("action = $action\n");
+  for my $k (keys %opts) {
+    ddebug("$k => $opts{$k}\n");
+  }
+  ddebug("arguments: @ARGV\n") if @ARGV;
 
-ddebug("action = $action\n");
-for my $k (keys %opts) {
-  ddebug("$k => $opts{$k}\n");
-}
-ddebug("arguments: @ARGV\n") if @ARGV;
+  if ($opts{"version"} || (defined $action && $action eq "version")) {
+    info(give_version());
+    finish(0);
+  }
+
+  if (defined($action) && ($action =~ m/^help/i)) {
+    $opts{"help"} = 1;
+  }
+
+  if (defined($action) && ($action =~ m/^print-arch$/i)) {
+    print TeXLive::TLUtils::platform(), "\n";
+    exit 0;
+  }
+
+  if ((!defined($action) || !$action) && !$opts{"help"}) {
+    die "$0: missing action; try --help if you need it.\n";
+  }
+
+  if ($opts{"help"}) {
+    # perldoc does ASCII emphasis on the output, so it's nice to use it.
+    # But not all Unix platforms have it, and on Windows our Config.pm
+    # can apparently interfere, so always skip it there.
+    my @noperldoc = ();
+    if (win32() || ! TeXLive::TLUtils::which("perldoc")) {
+      @noperldoc = ("-noperldoc", "1");
+    }
+    if ($action && ($action ne "help")) {
+      pod2usage(-exitstatus => 0, -verbose => 99,
+                -sections => "NAME|SYNOPSIS|ACTIONS/$action.*" , @noperldoc);
+    } else {
+      pod2usage(-exitstatus => 0, -verbose => 2, @noperldoc);
+    }
+  }
+
+  # unify arguments so that the $action contains paper in all cases
+  # and push the first arg back to @ARGV for action_paper processing
+  if ($action =~ /^(paper|xdvi|pdftex|dvips|dvipdfmx?|context)$/) {
+    unshift(@ARGV, $action);
+    $action = "paper";
+  }
+
+  # --machine-readable is only supported by update.
+  #
+  if ($::machinereadable && $action ne "update") {
+    tlwarn("tlmgr: --machine-readable output not supported for $action\n");
+  }
+
+  # check on supported arguments
+  #
+  my %suppargs;
+  %suppargs = %{$actionoptions{$action}}
+    if defined($actionoptions{$action});
+  my @notvalidargs;
+  for my $k (keys %opts) {
+    my $kk = $k;
+    if ($k eq "n" || $k eq "dry-run") {
+      $kk = "dry-run|n";
+    }
+    if (!defined($suppargs{$kk}) && !defined($globaloptions{$kk})) {
+      push @notvalidargs, $k;
+    }
+  }
+  if (@notvalidargs) {
+    my $msg =
+      "The following arguments are not supported for the action $action:\n";
+    for my $c (@notvalidargs) {
+      $msg .= " $c";
+    }
+    $msg .= "\n";
+    my @noperldoc = ();
+    if (win32() || ! TeXLive::TLUtils::which("perldoc")) {
+      @noperldoc = ("-noperldoc", "1");
+    }
+    pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1, @noperldoc);
+  }
+
+  # besides doing normal logging if -logfile is specified, we try to log
+  # package related actions (install, remove, update) to
+  # the package-log file TEXMFSYSVAR/web2c/tlmgr.log
+  $packagelogged = 0;  # how many msgs we logged
+  chomp (my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`);
+  $packagelogfile = $opts{"package-logfile"};
+  $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log";
+  #
+  # Try to open the packagelog file, but do NOT die when that does not work
+  if (!open(PACKAGELOG, ">>$packagelogfile")) {
+    debug("Cannot open package log file $packagelogfile for appending\n");
+    debug("Will not log package installation/removal/update for that run\n");
+    $packagelogfile = "";
+  }
+
+  $loadmediasrcerror = "Cannot load TeX Live database from ";
+
+  execute_action($action, @ARGV);
+  # end of main program.
+
+} # end main
 
 sub give_version {
   if (!defined($::version_string)) {
@@ -197,103 +318,6 @@ sub give_version {
   return $::version_string;
 }
 
-if ($opts{"version"} || (defined $action && $action eq "version")) {
-  info(give_version());
-  finish(0);
-}
-
-if (defined($action) && ($action =~ m/^help/i)) {
-  $opts{"help"} = 1;
-}
-
-if (defined($action) && ($action =~ m/^print-arch$/i)) {
-  print TeXLive::TLUtils::platform(), "\n";
-  exit 0;
-}
-
-if ((!defined($action) || !$action) && !$opts{"help"}) {
-  die "$0: missing action; try --help if you need it.\n";
-}
-
-if ($opts{"help"}) {
-  # perldoc does ASCII emphasis on the output, so it's nice to use it.
-  # But not all Unix platforms have it, and on Windows our Config.pm
-  # can apparently interfere, so always skip it there.
-  my @noperldoc = ();
-  if (win32() || ! TeXLive::TLUtils::which("perldoc")) {
-    @noperldoc = ("-noperldoc", "1");
-  }
-  if ($action && ($action ne "help")) {
-    pod2usage(-exitstatus => 0, -verbose => 99,
-              -sections => "NAME|SYNOPSIS|ACTIONS/$action.*" , @noperldoc);
-  } else {
-    pod2usage(-exitstatus => 0, -verbose => 2, @noperldoc);
-  }
-}
-
-# unify arguments so that the $action contains paper in all cases
-# and push the first arg back to @ARGV for action_paper processing
-if ($action =~ /^(paper|xdvi|pdftex|dvips|dvipdfmx?|context)$/) {
-  unshift(@ARGV, $action);
-  $action = "paper";
-}
-
-# --machine-readable is only supported by update.
-#
-if ($::machinereadable && $action ne "update") {
-  tlwarn("tlmgr: --machine-readable output not supported for $action\n");
-}
-
-# check on supported arguments
-#
-my %suppargs;
-%suppargs = %{$actionoptions{$action}}
-  if defined($actionoptions{$action});
-my @notvalidargs;
-for my $k (keys %opts) {
-  my $kk = $k;
-  if ($k eq "n" || $k eq "dry-run") {
-    $kk = "dry-run|n";
-  }
-  if (!defined($suppargs{$kk}) && !defined($globaloptions{$kk})) {
-    push @notvalidargs, $k;
-  }
-}
-if (@notvalidargs) {
-  my $msg =
-    "The following arguments are not supported for the action $action:\n";
-  for my $c (@notvalidargs) {
-    $msg .= " $c";
-  }
-  $msg .= "\n";
-  my @noperldoc = ();
-  if (win32() || ! TeXLive::TLUtils::which("perldoc")) {
-    @noperldoc = ("-noperldoc", "1");
-  }
-  pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1, @noperldoc);
-}
-
-# besides doing normal logging if -logfile is specified, we try to log
-# package related actions (install, remove, update) to
-# the package-log file TEXMFSYSVAR/web2c/tlmgr.log
-my $packagelogged = 0;  # how many msgs we logged
-chomp (my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`);
-my $packagelogfile = $opts{"package-logfile"};
-$packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log";
-#
-# Try to open the packagelog file, but do NOT die when that does not work
-if (!open(PACKAGELOG, ">>$packagelogfile")) {
-  debug("Cannot open package log file $packagelogfile for appending\n");
-  debug("Will not log package installation/removal/update for that run\n");
-  $packagelogfile = "";
-}
-
-my $loadmediasrcerror = "Cannot load TeX Live database from ";
-
-execute_action($action, @ARGV);
-# end of main program.
-
-
 
 sub execute_action {
   my ($action, @argv) = @_;
@@ -3300,6 +3324,7 @@ sub check_for_critical_updates
   return($criticalupdate);
 }
 
+1;
 
 __END__