From 5ab926badb5ad24f8b4b994ad5f18f0d2b3a6953 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 10 Jan 2008 10:53:59 +0000 Subject: add logging facilities, see extra email git-svn-id: svn://tug.org/texlive/trunk@6176 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl.pl | 93 ++++++-- Master/tlpkg/TeXLive/TLPDB.pm | 8 +- Master/tlpkg/TeXLive/TLPOBJ.pm | 6 +- Master/tlpkg/TeXLive/TLPSRC.pm | 3 +- Master/tlpkg/TeXLive/TLTREE.pm | 10 +- Master/tlpkg/TeXLive/TLUtils.pm | 57 ++++- Master/tlpkg/bin/check-file-coverage | 7 +- Master/tlpkg/bin/create-package-list | 10 +- Master/tlpkg/bin/generate-fmtutil | 11 +- Master/tlpkg/bin/generate-language | 11 +- Master/tlpkg/bin/generate-updmap | 11 +- Master/tlpkg/bin/mk_download_pkg | 14 +- Master/tlpkg/bin/tlpdb2container | 10 +- Master/tlpkg/bin/tlpdb2list | 7 +- Master/tlpkg/bin/tlpdb2updmap | 7 +- Master/tlpkg/bin/tlpfiles | 8 +- Master/tlpkg/bin/tlprm | 9 +- Master/tlpkg/bin/tlpsrc2container | 13 +- Master/tlpkg/bin/tlpsrc2tlpdb | 18 +- Master/tlpkg/bin/tlpsrc2tlpobj | 9 +- Master/tlpkg/bin/update-containers | 15 +- Master/tlpkg/man/TeXLive-TLUtils.1 | 438 +++++++++++++++++++++++++++++++++++ 22 files changed, 686 insertions(+), 89 deletions(-) create mode 100644 Master/tlpkg/man/TeXLive-TLUtils.1 diff --git a/Master/install-tl.pl b/Master/install-tl.pl index 590c19fc0ca..1a18e5b0a8e 100755 --- a/Master/install-tl.pl +++ b/Master/install-tl.pl @@ -6,6 +6,7 @@ # Copyright 2007 2008 Reinhard Kotucha, Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. +# our $texlive_release="2008"; @@ -33,10 +34,10 @@ BEGIN { } use TeXLive::TLUtils qw(initialize_installer media platform platform_desc - debug which getenv win32 unix program_exists architectures_available + which getenv win32 unix program_exists architectures_available additional_architectures_available_from_net get_system_tmpdir member mkdirhier make_var_skeleton make_local_skeleton install_package copy - install_packages dirname); + install_packages dirname tllog); use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLConfig qw($DefaultContainerExtension $InfraLocation); @@ -44,7 +45,15 @@ use Getopt::Long; use strict; -# used variables +# debugging/logging cmd lines options: +# -q shut up terminal output +# -qq shut up also log file output +# -d set $::LOGLEVELFILE to $::LOG_DEBUG +# -dd set $::LOGLEVELFILE to $::LOG_DDEBUG +# -ddd set $::LOGLEVELFILE to $::LOG_DDDEBUG +# +$::LOGLEVELFILE = $::LOG_NORMAL; +$::LOGLEVELTERMINAL = $::LOG_NORMAL; # # $install{$packagename} == 1 if it should be installed my %install; @@ -97,6 +106,11 @@ my $opt_url = ""; my $opt_profile = ""; my $opt_no_cls=0; my $opt_gui = 0; +my $opt_debug = 0; +my $opt_ddebug = 0; +my $opt_dddebug = 0; +my $opt_quiet = 0; +my $opt_qquiet = 0; $::netarchive = "archive"; $::diskarchive = "archive"; @@ -106,8 +120,38 @@ GetOptions("media=s" => \$opt_media, "gui", \$opt_gui, "netarchive=s" => \$::netarchive, "diskarchive=s" => \$::diskarchive, + "d" => \$opt_debug, + "dd" => \$opt_ddebug, + "ddd" => \$opt_dddebug, + "q" => \$opt_quiet, + "qq" => \$opt_qquiet, "url=s" => \$opt_url ) or die("No pod doc till now!"); +if ($opt_quiet) { + $::LOGLEVELTERMINAL = $::LOG_ZERO; +} +if ($opt_qquiet) { + $::LOGLEVELTERMINAL = $::LOG_ZERO; + $::LOGLEVELFILE = $::LOG_ZERO; +} +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DEBUG; +} +if ($opt_ddebug) { + $::LOGLEVELFILE = $::LOG_DDEBUG; +} +if ($opt_dddebug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; +} +# try to open a log file +if ($::LOGLEVELFILE > $::LOG_ZERO) { + if (open(LOGF,">install-tl.log")) { + $::LOGFILE = \*LOGF; + } else { + warn("Cannot create log file install-tl.log: $!\nContinuing without log file!\n"); + $::LOGLEVELFILE = $::LOG_ZERO; + } +} if ("$opt_media" =~ m/^CD/i) { $::_media_ = "CD"; } elsif ("$opt_media" =~ m/^NET/i) { @@ -118,10 +162,10 @@ if ("$opt_media" =~ m/^CD/i) { if ("$opt_profile" ne "") { if (-r "$opt_profile") { - print "Using automated installation using $opt_profile!\n"; + tllog($::LOG_NORMAL, "Using automated installation using $opt_profile!"); } else { $opt_profile = ""; - warn "Profile $opt_profile not readable, continuing in interactive mode!\n"; + tllog($::LOG_NORMAL, "Profile $opt_profile not readable, continuing in interactive mode!"); } } @@ -137,19 +181,18 @@ my $localtlpdb; my $system_tmpdir=get_system_tmpdir(); -print "Platform: ", platform, " => \'", platform_desc(platform), "\'\n"; -print "Distribution: "; +tllog($::LOG_NORMAL, "Platform: ", platform, " => \'", platform_desc(platform), "\'\n"); if (media() eq "DVD") { - print "live (uncompressed)\n"; + tllog($::LOG_NORMAL, "Distribution: live (uncompressed)\n"); } elsif (media() eq "CD") { - print "inst (compressed)\n"; + tllog($::LOG_NORMAL, "Distribution: inst (compressed)\n"); } elsif (media() eq "NET") { - print "net (downloading)\n"; + tllog($::LOG_NORMAL, "Distribution: net (downloading)\n"); } else { - print media(), "\n"; + tllog($::LOG_NORMAL, "Distribution: ", media(), "\n"); } -print "Directory for Temporary Files: '", $system_tmpdir, "\'\n"; -print "Installer Directory: '$::installerdir'\n"; +tllog($::LOG_NORMAL, "Directory for Temporary Files: '", $system_tmpdir, "\'\n"); +tllog($::LOG_NORMAL, "Installer Directory: '$::installerdir'\n"); initialize_installer(); load_tlpdb(); @@ -178,10 +221,10 @@ if ($opt_profile eq "") { eval { require Tk; }; if ($@) { # that didn't work out, so warn the user and continue with text mode - warn "Cannot load Tk, maybe something is missing!\n"; - warn "Error message from loading Tk:\n"; - warn "$@"; - warn "Continuing in Text Mode...\n"; + tllog($::LOG_NORMAL, "Cannot load Tk, maybe something is missing!\n"); + tllog($::LOG_NORMAL, "Error message from loading Tk:\n"); + tllog($::LOG_NORMAL, "$@\n"); + tllog($::LOG_NORMAL, "Continuing in Text Mode...\n"); $opt_gui = 0; } } @@ -202,7 +245,7 @@ if ($opt_profile eq "") { exit(2); } if ($ret != $MENU_INSTALL) { - warn "Unknown return value of run_menu: $ret\n"; + tllog($::LOG_NORMAL, "Unknown return value of run_menu: $ret\n"); exit(3); } } else { @@ -220,10 +263,10 @@ do_postinst_stuff(); dump_vars("$system_tmpdir/texlive.vars"); # if we installed from a profile we don't need to write it out if (-r "$vars{'TEXDIR'}/$InfraLocation/texlive.profile") { - warn "Not overwriting already present profile in $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"; + tllog($::LOG_NORMAL, "Not overwriting already present profile in $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"); } else { create_profile("$vars{'TEXDIR'}/$InfraLocation/texlive.profile"); - print "Profile written to $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"; + tllog($::LOG_DEBUG, "Profile written to $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"); } exit(0); @@ -359,11 +402,11 @@ sub calc_depends { # collect the already selected packages my @pre_selected = keys %install; - debug "initial number of installations: $#pre_selected\n"; + tllog($::LOG_DDEBUG, "initial number of installations: $#pre_selected\n"); # loop over all the pre_selected and add them foreach my $p (@pre_selected) { - debug "pre_selected $p\n"; + tllog($::LOG_DDEBUG, "pre_selected $p\n"); foreach my $p_dep ($tlpdb->get_package($p)->depends) { if ($p_dep =~ m/^(.*)\.ARCH$/) { my $foo = "$1"; @@ -384,7 +427,7 @@ sub calc_depends { # check for newly selected packages my @post_selected = keys %install; - debug "number of post installations: $#post_selected\n"; + tllog($::LOG_DDEBUG, "number of post installations: $#post_selected\n"); # set repeat condition if ($#pre_selected != $#post_selected) { @@ -417,7 +460,7 @@ sub load_tlpdb { } else { $master="$::installerdir"; } - print "Loading $master/$TeXLive::TLConfig::InfraLocation/$TeXLive::TLConfig::DatabaseName ...\n"; + tllog($::LOG_NORMAL, "Loading $master/$TeXLive::TLConfig::InfraLocation/$TeXLive::TLConfig::DatabaseName ...\n"); $tlpdb=TeXLive::TLPDB->new(root => "$master"); } @@ -765,7 +808,7 @@ sub do_win_registry_magic { # but with different registry pathes $classespath = "LMachine/Software/Classes/"; } else { - warn "non-admin users: no Path and PATHEXT setting possible.\n"; + tllog($::LOG_NORMAL, "non-admin users: no Path and PATHEXT setting possible.\n"); # for non-admin users the classes path is different # (Siep, email 2008-01-09) $classespath = "Users/Software/Classes/"; diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 007dc3477d3..74b18051218 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -51,7 +51,7 @@ C -- A database of TeX Live Packages use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation $DatabaseName); -use TeXLive::TLUtils qw(dirname mkdirhier); +use TeXLive::TLUtils qw(dirname mkdirhier tllog); use TeXLive::TLPOBJ; my $_listdir; @@ -134,7 +134,7 @@ sub from_file { my $found = 0; do { my $tlp = TeXLive::TLPOBJ->new; - &TeXLive::TLUtils::debug("creating tlp from $path..."); + tllog($::LOG_DDDEBUG, "creating tlp from $path...\n"); $found = $tlp->from_fh(\*TMP,1); if ($found) { $self->add_tlpobj($tlp); @@ -157,8 +157,8 @@ sub writeout { my $self = shift; my $fd = (@_ ? $_[0] : STDOUT); foreach (sort keys %{$self->{'tlps'}}) { - &TeXLive::TLUtils::debug("tlpname = $_"); - &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name); + tllog($::LOG_DDDEBUG, "tlpname = $_\n"); + tllog($::LOG_DDDEBUG, "foo: ", $self->{'tlps'}{$_}->name, "\n"); $self->{'tlps'}{$_}->writeout($fd); print $fd "\n"; } diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 2c9586ff775..bb2fd061aa9 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -65,7 +65,7 @@ sub from_fh { #while (my $line = $fh->getline) { while (my $line = <$fh>) { chomp($line); - &TeXLive::TLUtils::debug("reading line: >>>$line<<<"); + tllog($::LOG_DDDEBUG, "reading line: >>>$line<<<\n"); $line =~ /^\s*#/ && next; # skip comment lines if ($line =~ /^\s*$/) { if (!$started) { next; } @@ -568,7 +568,7 @@ sub make_container { die("Container method $type unknown!\n"); } unlink("$destdir/$containername"); - print "$compresscmd\n" if ($::opt_debug); + tllog($::LOG_DDDEBUG, "$compresscmd\n"); open ZIP, $compresscmd or die "Cannot open container program $compresscmd: $!\n"; map { if (! -f $_) { @@ -582,7 +582,7 @@ sub make_container { unlink("$tlpobjdir/$self->{'name'}.tlpobj"); rmdir("$tlpobjdir") if $removetlpobjdir; chdir($cwd); - print "Done $containername\n" if ($::opt_debug); + tllog($::LOG_DDDEBUG, "Done $containername\n"); } diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index 0821aef04cf..505d90196bd 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -9,6 +9,7 @@ package TeXLive::TLPSRC; use FileHandle; use TeXLive::TLConfig qw($CategoriesRegexp); +use TeXLive::TLUtils qw(tllog); use TeXLive::TLPOBJ; use TeXLive::TLTREE; @@ -115,7 +116,7 @@ sub from_file push @depends, "$1" if ("$1" ne ""); next; } else { - warn "$srcfile: unknown tlpsrc directive, please fix: $line\n"; + tllog($::LOG_NORMAL,"$srcfile: unknown tlpsrc directive, please fix: $line\n"); } } } diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm index a1cbb4279f7..7b9c70d7abc 100644 --- a/Master/tlpkg/TeXLive/TLTREE.pm +++ b/Master/tlpkg/TeXLive/TLTREE.pm @@ -219,7 +219,7 @@ sub _get_matching_files { } else { die "Unknown pattern $p"; } - TeXLive::TLUtils::debug("p=$p; matchfiles=@matchfiles"); + tllog($::LOG_DDDEBUG, "p=$p; matchfiles=@matchfiles\n"); return @matchfiles; } @@ -245,9 +245,9 @@ sub _get_files_matching_glob_pattern { return unless (defined($self->{'_filesofdir'}{$dirpart})); my @candfiles = @{$self->{'_filesofdir'}{$dirpart}}; foreach my $f (@candfiles) { - &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline"); + tllog($::LOG_DDDEBUG, "matching $f in $dirpart via glob $globline\n"); if ($f =~ /^$basepart$/) { - &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f"); + tllog($::LOG_DDDEBUG, "hit: globline=$globline, $dirpart/$f\n"); if ("$dirpart" eq ".") { push @returnfiles, "$f"; } else { @@ -258,9 +258,9 @@ sub _get_files_matching_glob_pattern { if ($dirpart =~ m@^bin/win32@) { # for arch=win32 under bin we also want to match .dll, .bat, .exe files foreach my $f (@candfiles) { - &TeXLive::TLUtils::debug("matching $f in $dirpart via glob $globline.{bat/exe}"); + tllog($::LOG_DDDEBUG, "matching $f in $dirpart via glob $globline.{bat/exe}\n"); if ($f =~ /^$basepart\.(bat|exe|dll)$/) { - &TeXLive::TLUtils::debug("hit: globline=$globline, $dirpart/$f"); + tllog($::LOG_DDDEBUG, "hit: globline=$globline, $dirpart/$f\n"); if ("$dirpart" eq ".") { push @returnfiles, "$f"; } else { diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 60fbc37fb3a..75c7c394498 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -60,7 +60,7 @@ C -- Utilities used in the TeX Live Infrastructure Modules TeXLive::TLUtils::sort_uniq(@list); TeXLive::TLUtils::push_uniq(\@list, @items); TeXLive::TLUtils::member($item, @list); - TeXLive::TLUtils::debug($string); + TeXLive::TLUtils::tllog($level, $string); TeXLive::TLUtils::kpsewhich; =head1 DESCRIPTION @@ -70,7 +70,7 @@ C -- Utilities used in the TeX Live Infrastructure Modules BEGIN { use Exporter (); - use vars qw( @ISA @EXPORT_OK ); + use vars qw( @ISA @EXPORT_OK @EXPORT); @ISA = qw(Exporter); @EXPORT_OK = qw( &platform @@ -100,10 +100,10 @@ BEGIN { &sort_uniq &push_uniq &member - &debug &kpsewhich "ewords ); + @EXPORT = qw(tllog); } @@ -1078,17 +1078,58 @@ sub member { =pod -=item C +=item C -The C function echos the argument strings to STDERR if -the global variable C is set. +Debugging output is controlled by 2 global variables: $::LOGLEVELTERMINAL +for the output to the terminal, and $::LOGLEVELFILE for the output to +the log file (whose filehandle should be saved in $::LOGFILE). + +If the first argument of C is less or equal to the respective +threshold the message is issued to STDERR and log file, respectively. + +If $::LOGFILE is not defined logging to a log file is completely disabled. + +Predefined levels of debugging are: $::LOG_NORMAL, $::LOG_DEBUG, $::LOG_DDEBUG, +and $::LOG_DDDEBUG with increasing level of detailedness. + +Note that all TeXLive modules to logging with $::LOG_DDDEBUG! + +By default the threshold for logging to the log file is $::LOG_DEBUG, and +the one for the terminal $::LOG_NORMAL. + +If you want to disable logging set the respective thershold to $::LOG_ZERO. =cut -sub debug { - print STDERR "tldbg: @_\n" if $::opt_debug; +$::LOG_ZERO = -1; +$::LOG_NORMAL = 0; +$::LOG_DEBUG = 1; +$::LOG_DDEBUG = 2; +$::LOG_DDDEBUG = 3; +if (!defined($::LOGLEVELFILE)) { + $::LOGLEVELFILE = $::LOG_DEBUG; +} +if (!defined($::LOGLEVELTERMINAL)) { + $::LOGLEVELTERMINAL = $::LOG_NORMAL; +} + +sub tllog { + my ($imp, @rest) = @_; + if (defined($::LOGFILE)) { + _tllog($::LOGLEVELFILE,$::LOGFILE,$imp,"tllog: ",@rest); + } + my $stderr = \*STDERR; + _tllog($::LOGLEVELTERMINAL,$stderr,$imp,"tllog: ",@rest); } +sub _tllog { + my ($threshold,$output,$imp, @rest) = @_; + if ($imp <= $threshold) { + print $output "@rest"; + } +} + + =pod =item C diff --git a/Master/tlpkg/bin/check-file-coverage b/Master/tlpkg/bin/check-file-coverage index 873a5fe2315..8e7329a4a43 100755 --- a/Master/tlpkg/bin/check-file-coverage +++ b/Master/tlpkg/bin/check-file-coverage @@ -37,7 +37,7 @@ my @IgnorePatterns = qw|support/ source/ setuptl/ chomp (my $opt_master = `cd $::mydir/../.. && pwd`); -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions( @@ -46,6 +46,11 @@ GetOptions( pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); diff --git a/Master/tlpkg/bin/create-package-list b/Master/tlpkg/bin/create-package-list index a57d004e012..85c3716c2a2 100755 --- a/Master/tlpkg/bin/create-package-list +++ b/Master/tlpkg/bin/create-package-list @@ -16,16 +16,22 @@ BEGIN { use strict; use TeXLive::TLPDB; -use TeXLive::TLUtils qw(dirname); +use TeXLive::TLUtils qw(dirname tllog); use Getopt::Long; use Pod::Usage; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions("debug!", 'help|?' => \$help ) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $help; + +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + die "$0: missing tlpdb argument; try --help if you need it.\n" if ($#ARGV<0); die "cannot read tlpdb file $ARGV[0]." if (! -r "$ARGV[0]"); diff --git a/Master/tlpkg/bin/generate-fmtutil b/Master/tlpkg/bin/generate-fmtutil index 79f24060e0f..c616ec9e330 100755 --- a/Master/tlpkg/bin/generate-fmtutil +++ b/Master/tlpkg/bin/generate-fmtutil @@ -18,14 +18,14 @@ use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; -use TeXLive::TLUtils qw/kpsewhich/; +use TeXLive::TLUtils qw/kpsewhich tllog/; use Getopt::Long; use Pod::Usage; use File::Path; use Cwd 'abs_path'; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; my $dest = ""; my $localconf = ""; @@ -35,6 +35,11 @@ GetOptions("debug!", "dest=s" => \$dest, pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); sub main @@ -47,7 +52,7 @@ sub main } $dest || ($dest = kpsewhich("TEXMFSYSVAR") . "/web2c/fmtutil.cnf"); $localconf || ($localconf = kpsewhich("TEXMFLOCAL") . "/web2c/fmtutil-local.cnf"); - print "writing fmtutil.cnf data to $dest\n"; + tllog($::LOG_NORMAL, "writing fmtutil.cnf data to $dest\n"); TeXLive::TLUtils::create_fmtutil($tlpdb, $dest, $localconf); } diff --git a/Master/tlpkg/bin/generate-language b/Master/tlpkg/bin/generate-language index 0e3711300fd..dc82106aa69 100755 --- a/Master/tlpkg/bin/generate-language +++ b/Master/tlpkg/bin/generate-language @@ -18,14 +18,14 @@ use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; -use TeXLive::TLUtils qw/kpsewhich/; +use TeXLive::TLUtils qw/kpsewhich tllog/; use Getopt::Long; use Pod::Usage; use File::Path; use Cwd 'abs_path'; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; my $dest = ""; my $localconf = ""; @@ -35,6 +35,11 @@ GetOptions("debug!", "dest=s" => \$dest, pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); sub main @@ -44,7 +49,7 @@ sub main my $tlpdb = TeXLive::TLPDB->new ("root" => "$Master"); $dest || ($dest = kpsewhich("TEXMFSYSVAR") . "/tex/generic/config/language.dat"); $localconf || ($localconf = kpsewhich("TEXMFLOCAL") . "/tex/generic/config/language-local.dat"); - print "writing language.dat data to $dest\n"; + tllog($::LOG_NORMAL, "writing language.dat data to $dest\n"); TeXLive::TLUtils::create_language($tlpdb, $dest, $localconf); } diff --git a/Master/tlpkg/bin/generate-updmap b/Master/tlpkg/bin/generate-updmap index 213b49bf7fc..bd4cca20038 100755 --- a/Master/tlpkg/bin/generate-updmap +++ b/Master/tlpkg/bin/generate-updmap @@ -18,14 +18,14 @@ use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; -use TeXLive::TLUtils qw/kpsewhich/; +use TeXLive::TLUtils qw/kpsewhich tllog/; use Getopt::Long; use Pod::Usage; use File::Path; use Cwd 'abs_path'; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; my $dest = ""; my $localconf = ""; @@ -35,6 +35,11 @@ GetOptions("debug!", "dest=s" => \$dest, "local=s" => \$localconf, pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); sub main @@ -44,7 +49,7 @@ sub main my $tlpdb = TeXLive::TLPDB->new ("root" => "$Master"); $dest || ($dest = kpsewhich("TEXMFSYSVAR") . "/web2c/updmap.cfg"); $localconf || ($localconf = kpsewhich("TEXMFLOCAL") . "/web2c/updmap-local.cfg"); - print "$0: writing new updmap.cfg to $dest\n"; + tllog($::LOG_NORMAL, "$0: writing new updmap.cfg to $dest\n"); TeXLive::TLUtils::create_updmap ($tlpdb, $dest, $localconf); } diff --git a/Master/tlpkg/bin/mk_download_pkg b/Master/tlpkg/bin/mk_download_pkg index 75685e3e8e9..58b748f2237 100755 --- a/Master/tlpkg/bin/mk_download_pkg +++ b/Master/tlpkg/bin/mk_download_pkg @@ -27,7 +27,7 @@ BEGIN { unshift (@INC, "$::installerdir/tlpkg"); } -use TeXLive::TLUtils qw(mkdirhier copy get_system_tmpdir); +use TeXLive::TLUtils qw(mkdirhier copy get_system_tmpdir tllog); use TeXLive::TLPDB; use TeXLive::TLPOBJ; use Getopt::Long; @@ -97,12 +97,12 @@ mkdir "$tmpdir" or die "Can't mkdir \"$tmpdir\".\n"; mkdir "$inst_tmp" or die "Can't mkdir \"$inst_tmp\".\n"; unless ($opt_quiet) { - print "thisdir: \"$thisdir\"\n"; - print "installerdir: \"$installerdir\"\n"; - print "sys_tmp: \"$sys_tmp\"\n"; - print "tmpdir: \"$tmpdir\"\n"; - print "inst_tmp: \"$inst_tmp\"\n"; - print "outputdir: \"$outputdir\"\n"; + tllog ($::LOG_NORMAL, "thisdir: \"$thisdir\"\n"); + tllog ($::LOG_NORMAL, "installerdir: \"$installerdir\"\n"); + tllog ($::LOG_NORMAL, "sys_tmp: \"$sys_tmp\"\n"); + tllog ($::LOG_NORMAL, "tmpdir: \"$tmpdir\"\n"); + tllog ($::LOG_NORMAL, "inst_tmp: \"$inst_tmp\"\n"); + tllog ($::LOG_NORMAL, "outputdir: \"$outputdir\"\n"); } die "outputdir \"$outputdir\" dosn't exist.\n" unless (-d "$outputdir"); diff --git a/Master/tlpkg/bin/tlpdb2container b/Master/tlpkg/bin/tlpdb2container index 33a4744f67f..2f77dd4acc6 100755 --- a/Master/tlpkg/bin/tlpdb2container +++ b/Master/tlpkg/bin/tlpdb2container @@ -18,13 +18,14 @@ use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; +use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; my $opt_all = 0; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $opt_outputdir = "./archive"; my $opt_relative = 0; my $help = 0; @@ -37,6 +38,11 @@ GetOptions("outputdir=s" => \$opt_outputdir, pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + my $srcsplit = 0; my $docsplit = 0; my $type = "lzma"; @@ -62,7 +68,7 @@ sub main if (($format eq "lzma") || ($format eq "zip")) { $type = $format; } else { - warn "unknown container format specified in 00texlive.config: $format\nIgnoring and continuing with $type!\n"; + tllog($::LOG_NORMAL, "unknown container format specified in 00texlive.config: $format\nIgnoring and continuing with $type!\n"); } # get list of packages. my $last = ""; diff --git a/Master/tlpkg/bin/tlpdb2list b/Master/tlpkg/bin/tlpdb2list index f2b74a37a1f..be28b8d2124 100755 --- a/Master/tlpkg/bin/tlpdb2list +++ b/Master/tlpkg/bin/tlpdb2list @@ -21,7 +21,7 @@ use Pod::Usage; use File::Path; my $opt_outputdir = "new-list"; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions("outputdir=s" => \$opt_outputdir, @@ -30,6 +30,11 @@ GetOptions("outputdir=s" => \$opt_outputdir, pod2usage(-exitstatus => 0, -verbose => 2) if $help; pod2usage(1) if ($#ARGV<0); +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + if (! -d $opt_outputdir) { mkpath ($opt_outputdir) or die "cannot mkdir $opt_outputdir: $!"; } diff --git a/Master/tlpkg/bin/tlpdb2updmap b/Master/tlpkg/bin/tlpdb2updmap index bfb51a5eedb..bd084eba8cd 100755 --- a/Master/tlpkg/bin/tlpdb2updmap +++ b/Master/tlpkg/bin/tlpdb2updmap @@ -26,13 +26,18 @@ use File::Path; our $NEW_UPDMAP_CFG; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions("debug!", "help|?" => \$help) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); sub main diff --git a/Master/tlpkg/bin/tlpfiles b/Master/tlpkg/bin/tlpfiles index 1409b875569..ca8af22b6c9 100755 --- a/Master/tlpkg/bin/tlpfiles +++ b/Master/tlpkg/bin/tlpfiles @@ -26,13 +26,19 @@ our $FILE; our %DB_BY_FILE; # used privately below. our @opt_pkgof = (); -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions("pkgof=s" => \@opt_pkgof, "debug!", "help|?" => \$help) or pod2usage(1); pod2usage(-exitstatus => 0, -verbose => 2) if $help; + +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); diff --git a/Master/tlpkg/bin/tlprm b/Master/tlpkg/bin/tlprm index 24c16ff624a..4f2bbab72ca 100755 --- a/Master/tlpkg/bin/tlprm +++ b/Master/tlpkg/bin/tlprm @@ -25,7 +25,7 @@ use Pod::Usage; use Getopt::Long; use Cwd 'abs_path'; -our $opt_debug = 0; +my $opt_debug = 0; my $opt_svn = 1; my $help = 0; @@ -34,6 +34,11 @@ GetOptions("svn!", pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); @@ -48,7 +53,7 @@ sub main foreach my $f (@ARGV) { my $obj = $tlpdb->get_package ($f); if (! $obj) { - warn "$0: no TeX Live package named $f.\n"; + tllog($::LOG_NORMAL, "$0: no TeX Live package named $f.\n"); $failure_count++; next; } diff --git a/Master/tlpkg/bin/tlpsrc2container b/Master/tlpkg/bin/tlpsrc2container index f8bec749499..a65aa9975ef 100755 --- a/Master/tlpkg/bin/tlpsrc2container +++ b/Master/tlpkg/bin/tlpsrc2container @@ -28,7 +28,7 @@ chomp (my $opt_master = `cd $::mydir/../.. && pwd`); my $opt_catalogue = ""; my $opt_type = "zip"; my $opt_outputdir = "./zip"; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; GetOptions( @@ -41,6 +41,11 @@ GetOptions( pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit(&main ()); sub main @@ -60,10 +65,10 @@ sub main my $tlc = undef; if (! -d $opt_catalogue) { - warn "$0: -c /Cat/a/logue not given, continuing without it.\n"; + tllog ($::LOG_NORMAL, "$0: -c /Cat/a/logue not given, continuing without it.\n"); } else { require TeXLive::TeXCatalogue; # not at compile time, for now anyway. - warn "$0: reading TeX Catalogue tree $opt_catalogue ...\n"; + tllog ($::LOG_NORMAL, "$0: reading TeX Catalogue tree $opt_catalogue ...\n"); $tlc = TeXLive::TeXCatalogue->new( "location" => $opt_catalogue ); } @@ -74,7 +79,7 @@ sub main @ARGV = glob ("*.tlpsrc"); } - warn "$0: reading Master tree $opt_master ...\n"; + tllog ($::LOG_NORMAL, "$0: reading Master tree $opt_master ...\n"); my $tltree = TeXLive::TLTREE->new( "svnroot" => $opt_master ); $tltree->init_from_svn; diff --git a/Master/tlpkg/bin/tlpsrc2tlpdb b/Master/tlpkg/bin/tlpsrc2tlpdb index f543ec89721..ecfd64dbb06 100755 --- a/Master/tlpkg/bin/tlpsrc2tlpdb +++ b/Master/tlpkg/bin/tlpsrc2tlpdb @@ -19,6 +19,7 @@ use TeXLive::TLPSRC; use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLTREE; +use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; @@ -26,7 +27,7 @@ use File::Path; my $opt_all = 0; my $opt_catalogue = ""; chomp (my $opt_master = `cd $::mydir/../.. && pwd`); -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; my $opt_nobinsplit = 0; @@ -39,6 +40,11 @@ GetOptions( pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + exit (&main ()); @@ -50,10 +56,10 @@ sub main my $tlc = undef; if (! -d $opt_catalogue) { - warn "$0: -c /Cat/a/logue not given, continuing without it.\n"; + tllog($::LOG_NORMAL, "$0: -c /Cat/a/logue not given, continuing without it.\n"); } else { require TeXLive::TeXCatalogue; # not at compile time, for now anyway. - warn "$0: reading TeX Catalogue tree $opt_catalogue ...\n"; + tllog($::LOG_NORMAL, "$0: reading TeX Catalogue tree $opt_catalogue ...\n"); $tlc = TeXLive::TeXCatalogue->new( "location" => $opt_catalogue ); } @@ -64,11 +70,11 @@ sub main @ARGV = glob ("*.tlpsrc"); } - warn "$0: reading Master tree $opt_master ...\n"; + tllog($::LOG_NORMAL, "$0: reading Master tree $opt_master ...\n"); my $tltree = TeXLive::TLTREE->new( "svnroot" => $opt_master ); $tltree->init_from_svn; - warn "$0: updating from tlpsrc ...\n"; + tllog($::LOG_NORMAL, "$0: updating from tlpsrc ...\n"); my $tldb = TeXLive::TLPDB->new; my $last = ""; my $src_count = 0; @@ -109,7 +115,7 @@ sub main if ($opt_all) { $tldb->root("$opt_master"); $tldb->save; - warn "$0: wrote $src_count packages ", $tldb->root, ".\n"; + tllog($::LOG_NORMAL, "$0: wrote $src_count packages ", $tldb->root, ".\n"); } else { $tldb->writeout; } diff --git a/Master/tlpkg/bin/tlpsrc2tlpobj b/Master/tlpkg/bin/tlpsrc2tlpobj index 26e9380fd2d..df0a823f4da 100755 --- a/Master/tlpkg/bin/tlpsrc2tlpobj +++ b/Master/tlpkg/bin/tlpsrc2tlpobj @@ -24,7 +24,7 @@ use File::Path; my $opt_master = "/src/TeX/texlive-svn/Master"; my $opt_outputdir = "./tlpobj"; -our $opt_debug = 0; +my $opt_debug = 0; my $help = 0; my $opt_catalogue = ""; @@ -36,6 +36,11 @@ GetOptions( pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + if (! -d "$opt_master") { die "Master $opt_master does not exists!"; } @@ -46,7 +51,7 @@ if (! -d "$opt_outputdir") { my $tlc; if (! -d "$opt_catalogue") { - warn "$0: -d /Cat/a/logue not given, continuing without it.\n"; + tllog($::LOG_NORMAL, "$0: -d /Cat/a/logue not given, continuing without it.\n"); } else { require TeXLive::TeXCatalogue; # not at compile time, for now anyway. $tlc = TeXLive::TeXCatalogue->new( 'location' => "$opt_catalogue" ); diff --git a/Master/tlpkg/bin/update-containers b/Master/tlpkg/bin/update-containers index 20c66d40a4b..206e1da829d 100755 --- a/Master/tlpkg/bin/update-containers +++ b/Master/tlpkg/bin/update-containers @@ -18,14 +18,14 @@ use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; -use TeXLive::TLUtils qw/debug/; +use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; my $opt_all = 0; our $mydir; -our $opt_debug = 0; +my $opt_debug = 0; my $opt_containerdir = "./archive"; my $opt_relative = 0; my $help = 0; @@ -36,6 +36,11 @@ GetOptions("containerdir=s" => \$opt_containerdir, pod2usage(-exitstatus => 0, -verbose => 2) if $help; +if ($opt_debug) { + $::LOGLEVELFILE = $::LOG_DDDEBUG; + $::LOGLEVELTERMINAL = $::LOG_DDDEBUG; +} + my $srcsplit = 0; my $docsplit = 0; my $type = "lzma"; @@ -79,17 +84,17 @@ sub main if (defined($archiverevs{$pkg})) { $oldrev = $archiverevs{$pkg}; } else { - debug("found a new package without container: $pkg\n"); + tllog($::LOG_DEBUG, "found a new package without container: $pkg\n"); } my $tlp = $tlpdb->get_package($pkg); my $newrev = 0; if (defined($tlp)) { $newrev = $tlp->revision; } else { - warn "It looks like $pkg has disappeared, you should remove its containers!\n"; + tllog($::LOG_DEBUG, "It looks like $pkg has disappeared, you should remove its containers!\n"); } if ($oldrev == $newrev) { - debug("$pkg up to date\n"); + tllog($::LOG_DEBUG, "$pkg up to date\n"); } elsif ($oldrev < $newrev) { push @todopacks, $pkg; } else { diff --git a/Master/tlpkg/man/TeXLive-TLUtils.1 b/Master/tlpkg/man/TeXLive-TLUtils.1 new file mode 100644 index 00000000000..95689741589 --- /dev/null +++ b/Master/tlpkg/man/TeXLive-TLUtils.1 @@ -0,0 +1,438 @@ +.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "TeXLive::TLUtils 3" +.TH TeXLive::TLUtils 3 "2008-01-10" "perl v5.8.8" "User Contributed Perl Documentation" +.SH "NAME" +\&\f(CW\*(C`TeXLive::TLUtils\*(C'\fR \-\- Utilities used in the TeX Live Infrastructure Modules +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 1 +\& use TeXLive::TLUtils; +.Ve +.Sh "Platform Detection" +.IX Subsection "Platform Detection" +.Vb 4 +\& TeXLive::TLUtils::platform; +\& TeXLive::TLUtils::platform_desc($platform); +\& TeXLive::TLUtils::win32; +\& TeXLive::TLUtils::unix; +.Ve +.Sh "System Tools" +.IX Subsection "System Tools" +.Vb 4 +\& TeXLive::TLUtils::getenv($string); +\& TeXLive::TLUtils::which($string); +\& TeXLive::TLUtils::program_exists($program); +\& TeXLive::TLUtils::get_system_tmpdir; +.Ve +.Sh "File Utulities" +.IX Subsection "File Utulities" +.Vb 5 +\& TeXLive::TLUtils::dirname($path); +\& TeXLive::TLUtils::basename($path); +\& TeXLive::TLUtils::dirname_and_basename($path); +\& TeXLive::TLUtils::mkdirhier($path); +\& TeXLive::TLUtils::copy($file, $target_dir); +.Ve +.Sh "Installer Functions" +.IX Subsection "Installer Functions" +.Vb 11 +\& TeXLive::TLUtils::media; +\& TeXLive::TLUtils::initialze_installer; +\& TeXLive::TLUtils::architectures_available; +\& TeXLive::TLUtils::additional_architectures_available_from_net; +\& TeXLive::TLUtils::make_var_skeleton($path); +\& TeXLive::TLUtils::make_local_skeleton($path); +\& TeXLive::TLUtils::create_fmtutil($tlpdb,$dest,$localconf); +\& TeXLive::TLUtils::create_updmap($tlpdb,$dest,$localconf); +\& TeXLive::TLUtils::create_language($tlpdb,$dest,$localconf); +\& TeXLive::TLUtils::install_packages($from_tlpdb,$to_tlpdb,@list); +\& TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform); +.Ve +.Sh "Miscellaneous" +.IX Subsection "Miscellaneous" +.Vb 5 +\& TeXLive::TLUtils::sort_uniq(@list); +\& TeXLive::TLUtils::push_uniq(\e@list, @items); +\& TeXLive::TLUtils::member($item, @list); +\& TeXLive::TLUtils::tllog($level, $string); +\& TeXLive::TLUtils::kpsewhich; +.Ve +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.Sh "Platform Detection" +.IX Subsection "Platform Detection" +.ie n .IP """platform""" 6 +.el .IP "\f(CWplatform\fR" 6 +.IX Item "platform" +If \f(CW\*(C`$^O=~/MSWin(32|64)$/i\*(C'\fR is true we know that we're on +Windows and we set the global variable \f(CW$::_platform_\fR to \f(CW\*(C`win32\*(C'\fR. +Otherwise we call \f(CW\*(C`config.guess\*(C'\fR. The output of \f(CW\*(C`config.guess\*(C'\fR +is filtered as described below. +.Sp +\&\s-1CPU\s0 type is determined by a regexp. And it's necessary to +\&\f(CW\*(C`s/i.86/i386/\*(C'\fR. +.Sp +For \s-1OS\s0 we need a list because we probably have something like +\&\f(CW\*(C`linux\-gnu\*(C'\fR but we need \f(CW\*(C`linux\*(C'\fR. This list might/should contain OSs +which are not currently supported. The list currently supports all +platforms supported by TeX Live 2007 plus Cygwin. +.Sp +If a particular platform is not found in this list we use the regexp +\&\f(CW\*(C`/.*\-(.*$)/\*(C'\fR as a last resort and hope it provides something useful. +.Sp +The result is stored in a global variable \f(CW$::_platform_\fR. If you call +\&\f(CW\*(C`platform\*(C'\fR repeatedly, only the first call of \f(CW\*(C`platform\*(C'\fR will access +the \s-1HD/CD/DVD\s0. +.ie n .IP """platform_desc($platform)""" 6 +.el .IP "\f(CWplatform_desc($platform)\fR" 6 +.IX Item "platform_desc($platform)" +Return a string which describes a particular platform. Same as in TeX +Live 2007 but NetBSD added. +.ie n .IP """win32""" 6 +.el .IP "\f(CWwin32\fR" 6 +.IX Item "win32" +Return \f(CW1\fR if platform is Windows and \f(CW0\fR otherwise. +.ie n .IP """unix""" 6 +.el .IP "\f(CWunix\fR" 6 +.IX Item "unix" +Return \f(CW1\fR if platform is \s-1UNIX\s0 and \f(CW0\fR otherwise. +.Sh "System Tools" +.IX Subsection "System Tools" +.ie n .IP """getenv($string)""" 6 +.el .IP "\f(CWgetenv($string)\fR" 6 +.IX Item "getenv($string)" +Get an environment variable. It is assumed that the environment +variable contains a path. On Windows all backslashes are replaced by +forward slashes as required by Perl. If this behavior is not desired, +use \f(CW$ENV{"$variable"}\fR instead. \f(CW0\fR is returned if the +environment variable is not set. +.ie n .IP """which($string)""" 6 +.el .IP "\f(CWwhich($string)\fR" 6 +.IX Item "which($string)" +\&\f(CW\*(C`which\*(C'\fR does the same as the \s-1UNIX\s0 command \f(CWwhich(1)\fR, but it is +supposed to work on Windows too. On Windows we have to try all the +extensions given in the \f(CW\*(C`PATHEXT\*(C'\fR environment variable. We also try +without appending an extension because if \f(CW$string\fR comes from an +environment variable, an extension might aleady be present. +.ie n .IP """program_exists($program)""" 6 +.el .IP "\f(CWprogram_exists($program)\fR" 6 +.IX Item "program_exists($program)" +Return \f(CW1\fR if \f(CW$program\fR is in \f(CW\*(C`PATH\*(C'\fR and \f(CW0\fR otherwise. +.ie n .IP """get_system_tmpdir""" 6 +.el .IP "\f(CWget_system_tmpdir\fR" 6 +.IX Item "get_system_tmpdir" +Evaluate the environment variables \f(CW\*(C`TMPDIR\*(C'\fR, \f(CW\*(C`TMP\*(C'\fR, and \f(CW\*(C`TEMP\*(C'\fR in +order to find the system temporary directory. +.Sh "File Utulities" +.IX Subsection "File Utulities" +.ie n .IP """dirname($path)""" 6 +.el .IP "\f(CWdirname($path)\fR" 6 +.IX Item "dirname($path)" +Return \f(CW$path\fR with its trailing \f(CW\*(C`/component\*(C'\fR removed. +.ie n .IP """basename($path)""" 6 +.el .IP "\f(CWbasename($path)\fR" 6 +.IX Item "basename($path)" +Return \f(CW$path\fR with any leading directory components removed. +.ie n .IP """dirname_and_basename($path)""" 6 +.el .IP "\f(CWdirname_and_basename($path)\fR" 6 +.IX Item "dirname_and_basename($path)" +Return both \f(CW\*(C`dirname\*(C'\fR and \f(CW\*(C`basename\*(C'\fR. Example: +.Sp +.Vb 1 +\& ($dirpart,$filepart) = dirname_and_basename ($path); +.Ve +.ie n .IP """mkdirhier($path, [$mode])""" 6 +.el .IP "\f(CWmkdirhier($path, [$mode])\fR" 6 +.IX Item "mkdirhier($path, [$mode])" +The function \f(CW\*(C`mkdirhier\*(C'\fR does the same as the \s-1UNIX\s0 command \f(CW\*(C`mkdir \-p\*(C'\fR. +The optional parameter sets the permission flags. +.ie n .IP """copy($file, $target_dir)""" 6 +.el .IP "\f(CWcopy($file, $target_dir)\fR" 6 +.IX Item "copy($file, $target_dir)" +Copy file \f(CW$file\fR to directory \f(CW$target_dir\fR. No external programs +are involved. Since we need \f(CW\*(C`sysopen()\*(C'\fR, the Perl module \f(CW\*(C`Fcntl.pm\*(C'\fR +is required. The time stamps are preserved and symlinks are created +on \s-1UNIX\s0 systems. On Windows, \f(CW\*(C`(\-l $file)\*(C'\fR will certainly never +return '\f(CW\*(C`true\*(C'\fR' and symlinks will be copied as regular files. +.Sp +\&\f(CW\*(C`copy\*(C'\fR invokes \f(CW\*(C`mkdirhier\*(C'\fR if target directories do not exist. +Files have mode \f(CW0777\fR\-\fIumask\fR if they are executable and +\&\f(CW0666\fR\-\fIumask\fR otherwise. +.ie n .IP """install_packages($from_tlpdb, $to_tlpdb, $what, $netarchsref, $opt_src, $opt_doc)""" 6 +.el .IP "\f(CWinstall_packages($from_tlpdb, $to_tlpdb, $what, $netarchsref, $opt_src, $opt_doc)\fR" 6 +.IX Item "install_packages($from_tlpdb, $to_tlpdb, $what, $netarchsref, $opt_src, $opt_doc)" +Installs the list of packages found in \f(CW@$what\fR (a ref to a list) into +the \s-1TLPDB\s0 given by \f(CW$to_tlpdb\fR. Information on files are taken from +the \s-1TLPDB\s0 \f(CW$from_tlpdb\fR. +.Sp +\&\f(CW$netarchrefs\fR is a reference to a list of arch/os combination which should +be installed from the network. +.Sp +\&\f(CW$opt_src\fR and \f(CW$opt_doc\fR specify whether srcfiles and docfiles should be +installed (currently implemented only for installation from \s-1DVD\s0). +.ie n .IP """install_package($what, $filelistref, $target, $platform)""" 6 +.el .IP "\f(CWinstall_package($what, $filelistref, $target, $platform)\fR" 6 +.IX Item "install_package($what, $filelistref, $target, $platform)" +This function installs the files given in @$filelistref from \f(CW$what\fR +into \f(CW$target\fR. +.Sp +If \f(CW$what\fR is a reference to a list of files then these files are +assumed to be readable and are copied to \f(CW$target\fR, creating dirs on +the way. In this case the list \f(CW@$filelistref\fR is not taken into +account. +.Sp +If \f(CW$what\fR starts with \f(CW\*(C`http://\*(C'\fR or \f(CW\*(C`ftp://\*(C'\fR then \f(CW$what\fR is +downloaded from the net and piped through c and \f(CW\*(C`tar\*(C'\fR. +.Sp +If \f(CW$what\fR ends with \f(CW\*(C`.tar.lzma\*(C'\fR (but does not start with \f(CW\*(C`http://\*(C'\fR or +\&\f(CW\*(C`ftp://\*(C'\fR) it is assumed to be a readable file on the system and is +piped through \f(CW\*(C`lzmadec\*(C'\fR and \f(CW\*(C`tar\*(C'\fR in the very same way. +.Sp +In both of the last cases currently the list \f(CW$@filelistref\fR currently +is not taken into account (should be fixed!). +.Sh "Installer Functions" +.IX Subsection "Installer Functions" +.ie n .IP """media""" 6 +.el .IP "\f(CWmedia\fR" 6 +.IX Item "media" +Return media type. Either \f(CW\*(C`CD\*(C'\fR, \f(CW\*(C`DVD\*(C'\fR, or \f(CW\*(C`NET\*(C'\fR. +.Sp +The result is stored in a global variable \f(CW$::_media_\fR. If you call +\&\f(CW\*(C`media\*(C'\fR repeatedly, only the first call of \f(CW\*(C`media\*(C'\fR will access the +\&\s-1CD/DVD\s0. +.ie n .IP """initialize_installer""" 6 +.el .IP "\f(CWinitialize_installer\fR" 6 +.IX Item "initialize_installer" +The function \f(CW\*(C`initialize_installer\*(C'\fR calls \f(CW\*(C`media\*(C'\fR and \f(CW\*(C`platform\*(C'\fR in +order to set the variables \f(CW$::_media_\fR and \f(CW$::_platform_\fR. +.Sp +Note that \f(CW$0\fR contains backslashes as path separators on Windows. +.Sp +Repeatedly calls to \f(CW\*(C`media\*(C'\fR or \f(CW\*(C`platform\*(C'\fR do not access the \s-1CD/DVD\s0 +again. +.ie n .IP """architectures_available""" 6 +.el .IP "\f(CWarchitectures_available\fR" 6 +.IX Item "architectures_available" +The function \f(CW\*(C`architectures_available\*(C'\fR returns a list of +supported platforms. +.ie n .IP """additional_architectures_available_from_net (\e%vars)""" 6 +.el .IP "\f(CWadditional_architectures_available_from_net (\e%vars)\fR" 6 +.IX Item "additional_architectures_available_from_net (%vars)" +The function \f(CW\*(C`additional_architectures_available_from_net\*(C'\fR returns a +list of additional platforms supported by the TeX Live server. It +downloads the file \f(CW\*(C`$::texlive_url/$::netarchive/texlive.pkgver\*(C'\fR and +creates a new object c<$::tlpdb_netbin>. The argument is a reference of +the global \f(CW%vars\fR hash. +.ie n .IP """make_var_skeleton($prefix)""" 6 +.el .IP "\f(CWmake_var_skeleton($prefix)\fR" 6 +.IX Item "make_var_skeleton($prefix)" +Generate a skeleton of empty directories in the \f(CW\*(C`TEXMFSYSVAR\*(C'\fR tree. +.ie n .IP """make_local_skeleton($prefix)""" 6 +.el .IP "\f(CWmake_local_skeleton($prefix)\fR" 6 +.IX Item "make_local_skeleton($prefix)" +Generate a skeleton of empty directories in the \f(CW\*(C`TEXMFLOCAL\*(C'\fR tree. +.ie n .IP """create_fmtutil($tlpdb, $dest, $localconf)""" 6 +.el .IP "\f(CWcreate_fmtutil($tlpdb, $dest, $localconf)\fR" 6 +.IX Item "create_fmtutil($tlpdb, $dest, $localconf)" +.PD 0 +.ie n .IP """create_updmap($tlpdb, $dest, $localconf)""" 6 +.el .IP "\f(CWcreate_updmap($tlpdb, $dest, $localconf)\fR" 6 +.IX Item "create_updmap($tlpdb, $dest, $localconf)" +.ie n .IP """create_language($tlpdb, $dest, $localconf)""" 6 +.el .IP "\f(CWcreate_language($tlpdb, $dest, $localconf)\fR" 6 +.IX Item "create_language($tlpdb, $dest, $localconf)" +.PD +These three functions create \f(CW\*(C`fmtutil.cnf\*(C'\fR, \f(CW\*(C`updmap.cfg\*(C'\fR, and +\&\f(CW\*(C`language.dat\*(C'\fR in in \f(CW$dest\fR (which by default is below +\&\f(CW$TEXMFSYSVAR\fR). These functions merge the information present in the +\&\s-1TLPDB\s0 \f(CW$tlpdb\fR (formats, maps, hyphenations) with local configuration +additions: \f(CW$localconf\fR. +.Sp +Currently the \*(L"merging\*(R" is done trivially by appending the content of +the local configuration files at the end of the file. This could be +improved (checking for duplicates). +.Sh "Miscellaneous" +.IX Subsection "Miscellaneous" +Ideas from Fabrice Popineau's \f(CW\*(C`FileUtils.pm\*(C'\fR. +.ie n .IP """sort_uniq(@list)""" 6 +.el .IP "\f(CWsort_uniq(@list)\fR" 6 +.IX Item "sort_uniq(@list)" +The \f(CW\*(C`sort_uniq\*(C'\fR function sorts the given array and throws away multiple +occurrences of elements. It returns a sorted and unified array. +.ie n .IP """push_uniq(\e@list, @items)""" 6 +.el .IP "\f(CWpush_uniq(\e@list, @items)\fR" 6 +.IX Item "push_uniq(@list, @items)" +The \f(CW\*(C`push_uniq\*(C'\fR function pushes the last elements on the list referenced +by the first argument. +.ie n .IP """member($item, @list)""" 6 +.el .IP "\f(CWmember($item, @list)\fR" 6 +.IX Item "member($item, @list)" +The \f(CW\*(C`member\*(C'\fR function returns true if the the first argument is contained +in the list of the remaining arguments. +.ie n .IP """tllog($type, $rest, ...)""" 6 +.el .IP "\f(CWtllog($type, $rest, ...)\fR" 6 +.IX Item "tllog($type, $rest, ...)" +Debugging output is controlled by 2 global variables: \f(CW$::LOGLEVELTERMINAL\fR +for the output to the terminal, and \f(CW$::LOGLEVELFILE\fR for the output to +the log file (whose filehandle should be saved in \f(CW$::LOGFILE\fR). +.Sp +If the first argument of \f(CW\*(C`tllog\*(C'\fR is less or equal to the respective +threshold the message is issued to \s-1STDERR\s0 and log file, respectively. +.Sp +If \f(CW$::LOGFILE\fR is not defined logging to a log file is completely disabled. +.Sp +Predefined levels of debugging are: \f(CW$::LOG_NORMAL\fR, \f(CW$::LOG_DEBUG\fR, \f(CW$::LOG_DDEBUG\fR, +and \f(CW$::LOG_DDDEBUG\fR with increasing level of detailedness. +.Sp +Note that all TeXLive modules to logging with \f(CW$::LOG_DDDEBUG\fR! +.Sp +By default the threshold for logging to the log file is \f(CW$::LOG_DEBUG\fR, and +the one for the terminal \f(CW$::LOG_NORMAL\fR. +.Sp +If you want to disable logging set the respective thershold to \f(CW$::LOG_ZERO\fR. +.ie n .IP """kpsewhich($varname)""" 6 +.el .IP "\f(CWkpsewhich($varname)\fR" 6 +.IX Item "kpsewhich($varname)" +This function expands the variable name using kpsewhich. The variable +name should not have a leading $. The kpsewhich binary has to be in +the path. +.SH "SEE ALSO" +.IX Header "SEE ALSO" +The modules TeXLive::TLPSRC, TeXLive::TLPOBJ, +TeXLive::TLPDB, TeXLive::TLTREE, and the +document Perl\-API.txt and the specification in the TeX Live +repository trunk/Master/tlpkg/doc/. +.SH "AUTHORS AND COPYRIGHT" +.IX Header "AUTHORS AND COPYRIGHT" +This script and its documentation were written for the TeX Live +distribution () and both are licensed under the +\&\s-1GNU\s0 General Public License Version 2 or later. -- cgit v1.2.3