diff options
author | mertz | 2005-01-16 10:27:35 +0000 |
---|---|---|
committer | mertz | 2005-01-16 10:27:35 +0000 |
commit | a3d6f9cf8c4b2212ad9482619a14c0726a6ea017 (patch) | |
tree | a9b3d7ffd2e65d8a5f7ebfa84644a540e34f3c70 /Perl/t | |
parent | d95df63ceb120cde92eb9d1015427bd847f474eb (diff) | |
download | tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.zip tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.gz tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.bz2 tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.xz |
- adding a 3rd param to the openLog function so that the log file
can be diverted to /dev/null
Diffstat (limited to 'Perl/t')
-rw-r--r-- | Perl/t/TestLog.pm | 35 |
1 files changed, 21 insertions, 14 deletions
diff --git a/Perl/t/TestLog.pm b/Perl/t/TestLog.pm index e50374a..6c84604 100644 --- a/Perl/t/TestLog.pm +++ b/Perl/t/TestLog.pm @@ -6,39 +6,46 @@ package TestLog; use IO::Handle; # for autoflushing the logs use Carp; -use strict; +use Exporter; +@ISA = qw(Exporter); -use vars qw( $VERSION @ISA @EXPORT ); +use vars qw( $VERSION @ISA); ($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); @EXPORT = qw( openLog setZincLog log test_eval test_no_eval printableItem printableArray printableList equal_flat_arrays nequal_cplx_arrays); +use strict; use constant ERROR => '--an error--'; -my $opt_log; +my $selected_loglevel; + sub openLog { - my ($outfile); - ($outfile,$opt_log) = @_; + my ($outfile, $loglevel, $no_logfile) = @_; - - if ( open LOG, "$outfile.prev" ) { + $selected_loglevel = $loglevel; + if (defined $no_logfile && $no_logfile) { + open LOG, "> /dev/null"; + } + else { + if ( open LOG, "$outfile.prev" ) { close LOG; unlink "$outfile.prev"; - } - if ( open LOG, $outfile ) { + } + if ( open LOG, $outfile ) { close LOG; link $outfile, "$outfile.prev"; unlink "$outfile"; + } + + open LOG,"> $outfile"; + autoflush LOG 1; # autoflush is important so that logs are up-to-date if Zinc crashes! } - - open LOG,">$outfile"; - autoflush LOG 1; # autoflush is important so that logs are up-to-date if Zinc crashes! } ### print log information to the logfile -### if $level is <= than opt_log (def = 0) then print log on the stdout +### if $level is <= than selected_loglevel (def = 0) then print log on the stdout ### - a loglevel of -100 means an error to be logged with #### prefix ### - a loglevel of -10 means an error in the test to be logged with ## prefix ### - a loglevel of 0 means an message to be usually printed (and logged in any case) @@ -47,7 +54,7 @@ sub openLog { sub log { my ($loglevel, @strgs) = @_; - if ($loglevel <= $opt_log) { + if ($loglevel <= $selected_loglevel) { print "#### " if $loglevel == -100; print "## " if $loglevel == -10; print @strgs; |