From 75c6e4796be6c1d0895051f5631d88c28959eee1 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Sun, 26 Jul 2009 10:35:54 +0000 Subject: sub main, to enable use as library git-svn-id: svn://tug.org/texlive/trunk@14448 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 387 ++++++++++++++++++---------------- 1 file changed, 206 insertions(+), 181 deletions(-) (limited to 'Master') 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__ -- cgit v1.2.3