diff options
author | Norbert Preining <preining@logic.at> | 2008-05-19 08:37:41 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-05-19 08:37:41 +0000 |
commit | 5177658bbbdaa8778cff3a2ac4fabb765bbcd8fe (patch) | |
tree | b00bfdb0be26f8f7ce3d626ac084b987c608c511 /Master/tlpkg/TeXLive/TLUtils.pm | |
parent | 58c870fa77e1ede0e7b21a7791d0fa5b8fd1542b (diff) |
big logging update, new logging facilities: info, debug, ddebug, tlwarn
and a way to automatically process the respective options -q and -v
via TeXLive::TLUtils::process_logging_options();
git-svn-id: svn://tug.org/texlive/trunk@8234 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 121 |
1 files changed, 57 insertions, 64 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 4a495ff6784..082591c89bf 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -59,7 +59,6 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::sort_uniq(@list); TeXLive::TLUtils::push_uniq(\@list, @items); TeXLive::TLUtils::member($item, @list); - TeXLive::TLUtils::tllog($level, $string); TeXLive::TLUtils::merge_into(\%to, \%from); TeXLive::TLUtils::texdir_check($texdir); TeXLive::TLUtils::kpsewhich; @@ -107,12 +106,14 @@ BEGIN { &setup_programs &download_file &merge_into + &process_logging_options ); - @EXPORT = qw(tllog setup_programs download_file); + @EXPORT = qw(setup_programs download_file info debug ddebug tlwarn process_logging_options win32); } use TeXLive::TLConfig; +use Getopt::Long; =pod @@ -522,7 +523,7 @@ sub install_packages { my $container_src_split = $fromtlpdb->config_src_container; my $container_doc_split = $fromtlpdb->config_doc_container; foreach my $package (@$what) { - tllog($::LOG_NORMAL, "Installing: $package\n"); + info("Installing: $package\n"); foreach my $h (@::install_packages_hook) { &$h("Installing: $package"); } @@ -552,7 +553,7 @@ sub install_packages { $container = "$::installerdir/$DiskArchive/$package.tar.lzma"; } else { # for now only warn and return, should (?) be die!? - warn "Cannot find a package $package (.zip or .lzma) in $::installerdir/$DiskArchive\n"; + tlwarn("Cannot find a package $package (.zip or .lzma) in $::installerdir/$DiskArchive\n"); next; } } elsif (&media eq 'NET') { @@ -678,12 +679,12 @@ sub install_package { # copy it to temp copy($what, "$target/temp"); } - tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n"); + debug("Un-lzmaing $lzmafile to $tarfile\n"); system("$lzmadec < $lzmafile_quote > $tarfile_quote"); if (! -f $tarfile) { die "Unpacking $lzmafile did not succeed, please retry!"; } - tllog($::LOG_DEBUG, "Unpacking $tarfile\n"); + debug("Unpacking $tarfile\n"); system($tar,"-x","-C",$target,"-f",$tarfile); unlink($tarfile, $lzmafile); } else { @@ -755,7 +756,7 @@ sub download_file { } elsif (defined($::progs{'wget'})) { $wget = $::progs{'wget'}; } else { - warn ("Programs have not been set up, trying simply wget"); + tlwarn ("Programs have not been set up, trying simply wget"); $wget = "wget"; } my $url; @@ -792,7 +793,7 @@ sub _download_file { my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"} || "-q -O"; - tllog($::LOG_DEBUG, "Trying to download $url\n"); + debug("Trying to download $url\n"); my $ret; if ($dest eq "|") { open(RETFH, "$wget $wgetargs - $url|") or @@ -808,7 +809,7 @@ sub _download_file { } # return false/undef in case the download did not succeed. return ($ret) unless $ret; - tllog($::LOG_DEBUG, "Download $url did succeed\n"); + debug("Download $url did succeed\n"); if ($dest eq "|") { return \*RETFH; } else { @@ -846,7 +847,7 @@ sub install_package_old { } } elsif (&media eq 'CD') { my $package="$::installerdir/$DiskArchive/$what[0]"; - open IN, "$package", or warn "Can't open '$package': $!\n" + open IN, "$package" or die "Can't open '$package': $!\n"; binmode IN; @@ -1183,71 +1184,63 @@ sub texdir_check { return 0; } -=pod - -=item C<tllog($type, $rest, ...)> - -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<tllog> 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. +sub logit { + my ($out, $level, @rest) = @_; + _logit($out, $level, @rest) unless $::opt_quiet; + _logit('file', $level, @rest); +} -=cut +sub _logit { + my ($out, $level, @rest) = @_; + if ($::opt_verbosity >= $level) { + # if $out is a ref/glob to STDOUT or STDERR, print it there + if (ref($out) eq "GLOB") { + print $out @rest; + } else { + # we should log it into the logfile, but that might be not initialized + # so either print it to the filehandle $::LOGFILE, or push it onto + # the to be printed log lines @::LOGLINES + if (defined($::LOGFILE)) { + print $::LOGFILE @rest; + } else { + push @::LOGLINES, "@rest"; + } + } + } +} -$::LOG_ZERO = -1; -$::LOG_NORMAL = 0; -$::LOG_DEBUG = 1; -$::LOG_DDEBUG = 2; -$::LOG_DDDEBUG = 3; -if (!defined($::LOGLEVELFILE)) { - $::LOGLEVELFILE = $::LOG_DEBUG; +sub info { + logit(\*STDOUT, 0, @_); } -if (!defined($::LOGLEVELTERMINAL)) { - $::LOGLEVELTERMINAL = $::LOG_NORMAL; + +sub debug { + logit(\*STDOUT, 1, @_); } -sub tllog { - my ($imp, @rest) = @_; - if (defined($::LOGFILE)) { - _tllog($::LOGLEVELFILE,$::LOGFILE,$imp,@rest); - } else { - _tllog($::LOGLEVELFILE,\@::LOGLINES,$imp,@rest); - } - my $out; - if ($imp == $::LOG_NORMAL) { - $out = \*STDOUT; - } else { - $out = \*STDERR; - } - _tllog($::LOGLEVELTERMINAL,$out,$imp,@rest); +sub ddebug { + logit(\*STDOUT, 2, @_); } -sub _tllog { - my ($threshold,$output,$imp, @rest) = @_; - if ($imp <= $threshold) { - if (ref($output) eq "GLOB") { - # we are writing to a file handle - print $output "@rest"; - } else { - push @{$output}, "@rest"; - } - } +sub tlwarn { + # warning should always done to stderr and the log file, + # independently from the verbosity level + my $savequiet = $::opt_quiet; + $::opt_quiet = 0; + logit(\*STDERR, -100, @_); + $::opt_quiet = $savequiet; } +sub process_logging_options { + $::opt_verbosity = 0; + $::opt_quiet = 0; + # check all the command line options for occurrences of -q and -v + # do not report errors + my $oldconfig = Getopt::Long::Configure(qw(pass_through)); + GetOptions("v+" => \$::opt_verbosity, "q" => \$::opt_quiet); + Getopt::Long::Configure($oldconfig); +} =pod |