summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-05-19 08:37:41 +0000
committerNorbert Preining <preining@logic.at>2008-05-19 08:37:41 +0000
commit5177658bbbdaa8778cff3a2ac4fabb765bbcd8fe (patch)
treeb00bfdb0be26f8f7ce3d626ac084b987c608c511 /Master/tlpkg/TeXLive/TLUtils.pm
parent58c870fa77e1ede0e7b21a7791d0fa5b8fd1542b (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.pm121
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