Menu
▾
▴
[log4perl-devel] Re: Fwd: Re: Release 0.23
|
From: Kevin G. <ke...@go...> - 2002-09-09 17:54:20
|
Mike, did you diff the website patch that works against the email patch
that doesn't? They both come out the same to me.
msc...@ao... wrote:
>>Maybe Mozilla is doing weird stuff... anyway, I
>>re-confirmed that the patch works. But to make life
>>easy, I put it up on my website.
>
>
> Interesting. Can you confirm the patch works even after you send mail to yourself?
>
> Anyway, the patch on your website worked (yay!) like a charm. Couple of questions/requests on your changes:
>
> * Looks like the error message here got garbeled (Logger.pm):
>
> my $after = shift || die("create_custom_level: forgot to pass in an after string!
>
> * What's the purpose of
>
> our %PRIORITY = (); # unless (%PRIORITY);
> our %LEVELS = () unless (%LEVELS);
> our %SYSLOG = () unless (%SYSLOG);
>
> And why the '#' in the first line?
>
> * Documentation: Can you add a couple of lines to Log::Log4perl.pm to show how to use the custom level features?
>
> * Why the logic
>
> # figure out new int value by AFTER + (AFTER+ 1) / 2
>
> if you could just store the priorities defined so far orderly in an array and switch to the next/previous element?
>
> * # This is a bit better way to create code on the fly than eval'ing strings.
> # -erik
>
> Nice. Does this mean they're (-d) debuggable now? Could we go all the way and use this in set_output_methods() as well?
>
> Looks like your foreach loop is outside the subroutine and therefore only called when the module is loaded:
>
> #now lets autogenerate the logger subs based on the defined priorities
> foreach my $level (keys %Log::Log4perl::Level::PRIORITY){
> create_log_level_methods($level);
> }
>
> Would be great if you could shed some light on these
> issues ... :)
>
> -- Mike
>
> Mike Schilli
> log...@pe...
> http://perlmeister.com
>
>
> ------------------------------------------------------------------------
>
> Subject:
> Re: Release 0.23 because of upcoming article?
> From:
> er...@se...
> Date:
> Sun, 08 Sep 2002 20:50:42 -0700
> To:
> "Erik W. Selberg" <er...@se...>
>
>
>
> Maybe Mozilla is doing weird stuff... anyway, I re-confirmed that the
> patch works. But to make life easy, I put it up on my website.
>
> http://speedstation.whizzyfoo.com/Log-Log4perl/custlevel3.patch
>
> Note: Log4perl.patchable is just a copy of a fresh checkout.
>
> 121 speedstation:Log-Log4perl.patchable >patch -p0 < ../custlevel3.patch
> patching file lib/Log/Log4perl/Appender.pm
> patching file lib/Log/Log4perl/Level.pm
> patching file lib/Log/Log4perl/Logger.pm
> patching file t/001Level.t
> patching file t/002Logger.t
> patching file t/016Export.t
> patching file t/024WarnDieCarp.t
> patching file t/025CustLevels.t
> 122 speedstation:Log-Log4perl.patchable >
>
> -e
>
> Erik W. Selberg wrote:
>
>> Hmm.... that's what I did.
>>
>> Well, here goes again. Can ya let me know what the output of patch is
>> if it doesn't go through?
>>
>> Thanks,
>> -e
>>
>> msc...@ao... wrote:
>>
>>> In a message dated Sun, 8 Sep 2002 4:31:30 AM Eastern Standard Time,
>>> er...@se... writes:
>>>
>>>
>>>
>>>> Please apply the patch..
>>>>
>>>
>>>
>>>
>>> Ok ... just tried to apply your latest patch, unfortunately it
>>> doesn't go through -- maybe it's my email client mangling the lines,
>>> so please
>>>
>>> 1) use "cvs diff -Nau" of your local dir against CVS
>>> 2) send the patch as an attachment
>>>
>>> Thanks!
>>>
>>> -- Mike
>>>
>>> Mike Schilli
>>> log...@pe...
>>> http://perlmeister.com
>>>
>>>
>>>
>>
>>
>> ------------------------------------------------------------------------
>>
>> ? out.txt
>> Index: lib/Log/Log4perl/Appender.pm
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Appender.pm,v
>> retrieving revision 1.8
>> diff -a -u -r1.8 Appender.pm
>> --- lib/Log/Log4perl/Appender.pm 21 Aug 2002 07:52:51 -0000 1.8
>> +++ lib/Log/Log4perl/Appender.pm 9 Sep 2002 02:11:14 -0000
>> @@ -83,8 +83,9 @@
>>
>> # Check if the appender has a last-minute veto in form
>> # of an "appender threshold"
>> - if($self->{level} < $
>> + if($self->{level} > $
>> Log::Log4perl::Level::PRIORITY{$level}) {
>> + print "$self->{level} > $level, aborting\n" if DEBUG;
>> return;
>> }
>>
>> Index: lib/Log/Log4perl/Level.pm
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Level.pm,v
>> retrieving revision 1.6
>> diff -a -u -r1.6 Level.pm
>> --- lib/Log/Log4perl/Level.pm 3 Sep 2002 18:12:17 -0000 1.6
>> +++ lib/Log/Log4perl/Level.pm 9 Sep 2002 02:11:16 -0000
>> @@ -7,22 +7,44 @@
>> use warnings;
>> use Carp;
>>
>> +# log4j, for whatever reason, puts 0 as all and MAXINT as OFF.
>> +# this seems less optimal, as more logging would imply a higher
>> +# level. But oh well. Probably some brokenness that has persisted. :)
>> +use constant ALL_INT => 0;
>> +use constant DEBUG_INT => 10000;
>> +use constant INFO_INT => 20000;
>> +use constant WARN_INT => 30000;
>> +use constant ERROR_INT => 40000;
>> +use constant FATAL_INT => 50000;
>> +use constant OFF_INT => (2 ** 31) - 1;
>> +
>> no strict qw(refs);
>> +use vars qw(%PRIORITY %LEVELS);
>> +
>> +our %PRIORITY = (); # unless (%PRIORITY);
>> +our %LEVELS = () unless (%LEVELS);
>> +our %SYSLOG = () unless (%SYSLOG);
>> +
>> +sub add_priority {
>> + my ($prio, $intval, $syslog) = @_;
>> + $prio = uc($prio); # just in case;
>> +
>> + $PRIORITY{$prio} = $intval;
>> + $LEVELS{$intval} = $prio;
>> + $SYSLOG{$prio} = $syslog if defined($syslog);
>> +}
>> +
>> +# create the basic priorities
>> +add_priority("OFF", OFF_INT, -1);
>> +add_priority("FATAL", FATAL_INT, 0);
>> +add_priority("ERROR", ERROR_INT, 3);
>> +add_priority("WARN", WARN_INT, 4);
>> +add_priority("INFO", INFO_INT, 6);
>> +add_priority("DEBUG", DEBUG_INT, 7);
>> +add_priority("ALL", ALL_INT, 7);
>>
>> -our %PRIORITY = (
>> - "FATAL" => 0,
>> - "ERROR" => 3,
>> - "WARN" => 4,
>> - "INFO" => 6,
>> - "DEBUG" => 7,
>> -) unless %PRIORITY;
>> -
>> - # Reverse mapping
>> -our %LEVELS = map { $PRIORITY{$_} => $_ } keys %PRIORITY;
>> -
>> - # Min and max
>> -$PRIORITY{'OFF'} = $PRIORITY{'FATAL'};
>> -$PRIORITY{'ALL'} = $PRIORITY{'DEBUG'};
>> +# we often sort numerically, so a helper func for readability
>> +sub numerically {$a <=> $b}
>>
>> ###########################################
>> sub import {
>> @@ -43,6 +65,9 @@
>> my $name = "$namespace$key";
>> my $value = $PRIORITY{$key};
>> *{"$name"} = \$value;
>> + my $nameint = "$namespace${key}_INT";
>> + my $func = uc($key) . "_INT";
>> + *{"$nameint"} = \&$func;
>> }
>> }
>>
>> @@ -75,8 +100,11 @@
>> if (exists $LEVELS{$priority}) {
>> return $LEVELS{$priority}
>> }else {
>> - die "priority '$priority' is not a valid error level number
>> (".join ('|', keys %LEVELS),')';
>> + die("priority '$priority' is not a valid error level number (",
>> + join("|", sort numerically keys %LEVELS), "
>> + )");
>> }
>> +
>> }
>>
>> ##################################################
>> @@ -120,8 +148,9 @@
>>
>> foreach (1..$delta){
>> #so the list is DEBUG, INFO, WARN, ERROR, FATAL
>> - foreach my $p (reverse sort keys %LEVELS){
>> - if ($p < $old_priority) {
>> + # but remember, the numbers go in reverse order!
>> + foreach my $p (sort numerically keys %LEVELS){
>> + if ($p > $old_priority) {
>> $new_priority = $p;
>> last;
>> }
>> @@ -140,8 +169,9 @@
>>
>> foreach (1..$delta){
>> #so the list is FATAL, ERROR, WARN, INFO, DEBUG
>> - foreach my $p (sort keys %LEVELS){
>> - if ($p > $old_priority) {
>> + # but remember, the numbers go in reverse order!
>> + foreach my $p (reverse sort numerically keys %LEVELS){
>> + if ($p < $old_priority) {
>> $new_priority = $p;
>> last;
>> }
>> @@ -150,6 +180,25 @@
>> }
>> return $new_priority;
>> }
>> +
>> +sub isGreaterOrEqual {
>> + my $lval = shift;
>> + my $rval = shift;
>> + + # in theory, we should check if the above really ARE valid levels.
>> + # but we just use numeric comparison, since they aren't really
>> classes.
>> +
>> + # oh, yeah, and 'cuz level ints go from 0 .. N with 0 being highest,
>> + # these are reversed.
>> + return $lval <= $rval;
>> +}
>> +
>> +######################################################################
>> +# +# since the integer representation of levels is reversed from what
>> +# we normally want, we don't want to use < and >... instead, we
>> +# want to use this comparison function
>> +
>>
>> 1;
>>
>> Index: lib/Log/Log4perl/Logger.pm
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Logger.pm,v
>> retrieving revision 1.25
>> diff -a -u -r1.25 Logger.pm
>> --- lib/Log/Log4perl/Logger.pm 3 Sep 2002 18:13:41 -0000 1.25
>> +++ lib/Log/Log4perl/Logger.pm 9 Sep 2002 02:11:20 -0000
>> @@ -139,8 +139,11 @@
>>
>> my %priority = %Log::Log4perl::Level::PRIORITY; #convenience and cvs
>>
>> + # changed to >= from <= as level ints were reversed
>> foreach my $levelname (keys %priority){
>> - if ($priority{$levelname} <= $level) {
>> + if (Log::Log4perl::Level::isGreaterOrEqual($level,
>> + $priority{$levelname}
>> + )) {
>> print " ($priority{$levelname} <= $level)\n"
>> if DEBUG;
>> $self->{$levelname} = $coderef;
>> @@ -467,6 +470,8 @@
>> ##################################################
>> my ($self, $priority, @messages) = @_;
>>
>> + confess("log: No priority given!") unless defined($priority);
>> +
>> # Just in case of 'init_and_watch' -- see Changes 0.21
>> $_[0] = $LOGGERS_BY_NAME->{$_[0]->{category}} if defined
>> $LAST_CHECKED_AT;
>>
>> @@ -480,31 +485,111 @@
>> Log::Log4perl::Level::to_level($priority));
>> }
>>
>> +######################################################################
>> +#
>> +# create_custom_level +# creates a custom level
>> +# in theory, could be used to create the default ones
>>
>> -#now lets autogenerate the logger subs based on the defined priorities
>> -foreach my $level (keys %Log::Log4perl::Level::PRIORITY){
>> +sub create_custom_level {
>> + my $level = shift || die("create_custom_level: forgot to pass in a
>> level string!");
>> + my $after = shift || die("create_custom_level: forgot to pass in an
>> after string!");
>> + my $syslog_equiv = shift; # can be undef
>>
>> - my $lclevel = lc $level;
>> - my $code = <<EOL;
>> + ## only let users create custom levels before initialization
>>
>> - sub $lclevel {
>> - print "$lclevel: (\$_[0]->{category}/\$_[0]->{level})
>> [\@_]\n" if DEBUG;
>> - init_warn() unless \$INITIALIZED;
>> - \$_[0]->{$level}(\@_, '$level');
>> - }
>> - - sub is_$lclevel { return \$_[0]->level() >= \$$level; }
>> -EOL
>> + die("create_custom_level must be called before init or first
>> get_logger() call") if ($INITIALIZED);
>>
>> - eval $code;
>> + my %PRIORITY = %Log::Log4perl::Level::PRIORITY; #convenience
>>
>> - if ($@) {
>> - die "Log4perl init failed, could not define a subroutine for
>> $level:\n$code\n$@";
>> - }
>> + die("create_custom_level: no such level \"$after\"! Use one of: ",
>> join(", ", sort keys %PRIORITY))
>> + unless $PRIORITY{$after};
>> +
>> + # figure out new int value by AFTER + (AFTER+ 1) / 2
>> +
>> + my $next_prio =
>> Log::Log4perl::Level::get_lower_level($PRIORITY{$after}, 1);
>> + my $cust_prio = int(($PRIORITY{$after} + $next_prio) / 2);
>> +
>> +# CORE::warn("Creating prio $cust_prio between $PRIORITY{$after}
>> and $next_prio");
>> +
>> + die(qq{create_custom_level: Calculated level of $cust_prio already
>> exists!
>> + This should only happen if you've made some insane number of
>> custom
>> + levels (like 15 one after another)
>> + You can usually fix this by re-arranging your code from:
>> + create_custom_level("cust1", X);
>> + create_custom_level("cust2", X);
>> + create_custom_level("cust3", X);
>> + create_custom_level("cust4", X);
>> + create_custom_level("cust5", X);
>> + into:
>> + create_custom_level("cust3", X);
>> + create_custom_level("cust5", X);
>> + create_custom_level("cust4", 4);
>> + create_custom_level("cust2", cust3);
>> + create_custom_level("cust1", cust2);
>> + }) if ($Log::Log4perl::Level::LEVELS{$cust_prio});
>> +
>> + Log::Log4perl::Level::add_priority($level, $cust_prio, $syslog_equiv);
>> +
>> + print("Adding prio $level at $cust_prio\n") if DEBUG;
>> +
>> + # get $LEVEL into namespace of Log::Log4perl::Logger to + # create
>> $logger->foo nd $logger->is_foo
>> + my $name = "Log::Log4perl::Logger::";
>> + my $key = $level;
>> +
>> + no strict qw(refs);
>> + # be sure to use ${Log...} as CVS adds log entries for Log
>> + *{"$name$key"} = \${Log::Log4perl::Level::PRIORITY{$level}};
>>
>> + # now, stick it in the caller's namespace
>> + $name = caller(0) . "::";
>> + *{"$name$key"} = \${Log::Log4perl::Level::PRIORITY{$level}};
>> + use strict qw(refs);
>> +
>> + create_log_level_methods($level);
>> +
>> + return 0;
>>
>> }
>>
>> +########################################
>> +#
>> +# if we were hackin' lisp (or scheme), we'd be returning some lambda
>> +# expressions. But we aren't. :) So we'll just create some strings and
>> +# eval them.
>> +sub create_log_level_methods {
>> + my $level = shift || die("create_log_level_methods: forgot to pass
>> in a level string!");
>> + my $lclevel = lc($level);
>> + my $levelint = uc($level) . "_INT";
>> +
>> + no strict qw(refs);
>> +
>> + # This is a bit better way to create code on the fly than eval'ing
>> strings.
>> + # -erik
>> +
>> + *{__PACKAGE__ . "::$lclevel"} = sub {
>> + print "$lclevel: ($_[0]->{category}/$_[0]->{level}) [@_]\n"
>> if DEBUG;
>> + init_warn() unless $INITIALIZED;
>> + $_[0]->{$level}(@_, $level);
>> + };
>> +
>> + *{__PACKAGE__ . "::is_$lclevel"} = sub { + return
>> Log::Log4perl::Level::isGreaterOrEqual($_[0]->level(),
>> + $$level); + };
>> + + use strict qw(refs);
>> +
>> + return 0;
>> +
>> +}
>> +
>> +#now lets autogenerate the logger subs based on the defined priorities
>> +foreach my $level (keys %Log::Log4perl::Level::PRIORITY){
>> + create_log_level_methods($level);
>> +}
>> +
>> ##################################################
>> #expected args are $logger, $msg, $levelname
>>
>> @@ -602,8 +687,9 @@
>> my $self = shift;
>> if ($self->is_fatal()) {
>> $self->fatal(@_);
>> - $self->and_die(@_);
>> }
>> + # no matter what, we die... 'cuz logdie wants you to die.
>> + $self->and_die(@_);
>> }
>>
>> ##################################################
>> @@ -641,24 +727,26 @@
>> # croaks and confess are FATAL level
>> sub logcroak {
>> my $self = shift;
>> + my $message = Carp::shortmess(@_);
>> if ($self->is_fatal()) {
>> - my $message = Carp::shortmess(@_);
>> foreach (split(/\n/, $message)) {
>> $self->fatal("$_\n");
>> }
>> - die(noop($message));
>> }
>> + # again, we die no matter what
>> + die(noop($message));
>> }
>>
>> sub logconfess {
>> my $self = shift;
>> + my $message = Carp::longmess(@_);
>> if ($self->is_fatal()) {
>> - my $message = Carp::longmess(@_);
>> foreach (split(/\n/, $message)) {
>> $self->fatal("$_\n");
>> }
>> - die(noop($message));
>> }
>> + # again, we die no matter what
>> + die(noop($message));
>> }
>>
>> ##################################################
>> @@ -677,8 +765,8 @@
>> my $self = shift;
>> if ($self->is_error()) {
>> $self->error(@_);
>> - $self->and_die(@_);
>> }
>> + $self->and_die(@_);
>> }
>>
>> sub inc_level {
>> Index: t/001Level.t
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/t/001Level.t,v
>> retrieving revision 1.1.1.1
>> diff -a -u -r1.1.1.1 001Level.t
>> --- t/001Level.t 3 Jul 2002 21:53:33 -0000 1.1.1.1
>> +++ t/001Level.t 9 Sep 2002 02:11:20 -0000
>> @@ -7,7 +7,9 @@
>> # change 'tests => 1' to 'tests => last_test_to_print';
>> #########################
>> use Test;
>> -BEGIN { plan tests => 10 };
>> +use strict;
>> +
>> +BEGIN { plan tests => 20 };
>> use Log::Log4perl::Level;
>> BEGIN {
>> Log::Log4perl::Level->import("Level");
>> @@ -16,16 +18,23 @@
>> ok(1); # If we made it this far, we're ok.
>>
>> # Import them into the 'main' namespace;
>> -ok($FATAL < $ERROR);
>> -ok($ERROR < $INFO);
>> -ok($INFO < $DEBUG);
>> +foreach ($DEBUG, $INFO, $WARN, $ERROR, $FATAL) {
>> + ok(Log::Log4perl::Level::to_level($_));
>> +}
>> # Import them into the 'Level' namespace;
>> -ok($Level::FATAL < $Level::ERROR);
>> -ok($Level::ERROR < $Level::INFO);
>> -ok($Level::INFO < $Level::DEBUG);
>> +foreach ($Level::DEBUG, $Level::INFO, $Level::WARN, $Level::ERROR,
>> $Level::FATAL) {
>> + ok(Log::Log4perl::Level::to_level($_));
>> +}
>>
>> # Import them into the 'My::Level' namespace;
>> -ok($My::Level::FATAL < $My::Level::ERROR);
>> -ok($My::Level::ERROR < $My::Level::INFO);
>> -ok($My::Level::INFO < $My::Level::DEBUG);
>> +foreach ($My::Level::DEBUG, $My::Level::INFO, $My::Level::WARN,
>> $My::Level::ERROR, $My::Level::FATAL) {
>> + ok(Log::Log4perl::Level::to_level($_));
>> +}
>> +
>> +# ok, now let's check to make sure the relative order is correct.
>> +
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($DEBUG, $INFO));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($INFO, $WARN));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($WARN, $ERROR));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($ERROR, $FATAL));
>> Index: t/002Logger.t
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/t/002Logger.t,v
>> retrieving revision 1.14
>> diff -a -u -r1.14 002Logger.t
>> --- t/002Logger.t 6 Aug 2002 19:36:25 -0000 1.14
>> +++ t/002Logger.t 9 Sep 2002 02:11:20 -0000
>> @@ -9,10 +9,18 @@
>> use strict;
>>
>> #########################
>> -# change 'tests => 1' to 'tests => last_test_to_print';
>> -#########################
>> -use Test;
>> +# used Test::Simple to help debug the test script
>> +use Test::Simple tests => 46;
>>
>> +# to test, as ok() suppresses DEBUG output
>> +# my $i = 1;
>> +# sub ok {
>> +# my ($r, $s) = @_;
>> +# print "not " unless ($r);
>> +# print "ok ", $i++;
>> +# print " - $s" if (defined($s));
>> +# print "\n";
>> +# }
>> use Log::Log4perl;
>> use Log::Log4perl::Level;
>> @@ -30,22 +38,22 @@
>> my $log9 = Log::Log4perl->get_logger("abc::def::ghi");
>>
>> # Loggers for the same namespace have to be identical
>> -ok($log1 == $log2);
>> -ok($log4 == $log5);
>> -ok($log6 == $log7);
>> -ok($log1 == $log8);
>> -ok($log3 == $log9);
>> +ok($log1 == $log2, "Log1 same as Log2");
>> +ok($log4 == $log5, "Log4 same as Log5");
>> +ok($log6 == $log7, "Log6 same as Log7");
>> +ok($log1 == $log8, "Log1 same as Log8");
>> +ok($log3 == $log9, "log3 same as Log9");
>>
>> # Loggers for different namespaces have to be different
>> -ok($log1 != $log3);
>> -ok($log3 != $log4);
>> -ok($log1 != $log6);
>> -ok($log3 != $log6);
>> -ok($log5 != $log6);
>> -ok($log5 != $log7);
>> -ok($log5 != $log1);
>> -ok($log7 != $log8);
>> -ok($log8 != $log9);
>> +ok($log1 != $log3, "Log1 not Log3");
>> +ok($log3 != $log4, "Log3 not Log4");
>> +ok($log1 != $log6, "Log1 not Log6");
>> +ok($log3 != $log6, "Log3 not Log6");
>> +ok($log5 != $log6, "Log5 not Log6");
>> +ok($log5 != $log7, "Log5 not Log7");
>> +ok($log5 != $log1, "Log5 not Log1");
>> +ok($log7 != $log8, "Log7 not Log8");
>> +ok($log8 != $log9, "Log8 not Log9");
>>
>> my $app = Log::Log4perl::Appender->new(
>> "Log::Log4perl::TestBuffer");
>> @@ -55,10 +63,14 @@
>> ##################################################
>> $log1->add_appender($app);
>> $log1->level($ERROR);
>> +
>> +# warn "level is: ", $log1->level(), "\n";
>> +
>> $log1->error("Error Message");
>> $log1->debug("Debug Message");
>> -ok($app->buffer(), "ERROR - Error Message\n");
>> +ok($app->buffer() eq "ERROR - Error Message\n", "log1 app buffer
>> contains ERROR - Error Message");
>>
>> +# warn "app buffer is: \"", $app->buffer(), "\"\n";
>>
>> ##################################################
>> # Allow debug
>> @@ -67,7 +79,10 @@
>> $app->buffer("");
>> $log1->error("Error Message");
>> $log1->debug("Debug Message");
>> -ok($app->buffer(), "ERROR - Error Message\nDEBUG - Debug Message\n");
>> +ok($app->buffer() eq "ERROR - Error Message\nDEBUG - Debug Message\n",
>> + "app buffer contains both ERROR and DEBUG message");
>> +
>> +# warn "app buffer is: \"", $app->buffer(), "\"\n";
>>
>> ##################################################
>> # Multiple Appenders
>> @@ -84,8 +99,8 @@
>> $log1->level($ERROR);
>> $log1->error("Error Message");
>> #TODO
>> -ok($app->buffer(), "ERROR - Error Message\n");
>> -ok($app2->buffer(), "ERROR - Error Message\n");
>> +ok($app->buffer() eq "ERROR - Error Message\n", "app buffer contains
>> ERROR only");
>> +ok($app2->buffer() eq "ERROR - Error Message\n", "app2 buffer
>> contains ERROR only");
>>
>> ##################################################
>> # Multiple Appenders in different hierarchy levels
>> @@ -109,7 +124,7 @@
>> $log1->error("Error Message");
>>
>> # Should be distributed to root
>> -ok($app3->buffer(), "ERROR - Error Message\n");
>> +ok($app3->buffer() eq "ERROR - Error Message\n", "app3 buffer
>> contains ERROR");
>> ##################################################
>> # Log in lower levels and propagate to root
>> ##################################################
>> @@ -121,9 +136,9 @@
>> $log2->add_appender($app2);
>> # log3 already has app3 attached
>> $log1->error("Error Message");
>> -ok($app->buffer(), "ERROR - Error Message\n");
>> -ok($app2->buffer(), "ERROR - Error Message\n");
>> -ok($app3->buffer(), "ERROR - Error Message\n");
>> +ok($app->buffer() eq "ERROR - Error Message\n", "app buffer contains
>> ERROR");
>> +ok($app2->buffer() eq "ERROR - Error Message\n", "app2 buffer
>> contains ERROR");
>> +ok($app3->buffer() eq "ERROR - Error Message\n", "app3 buffer
>> contains ERROR");
>>
>> ##################################################
>> # Block appenders via priority @@ -137,9 +152,9 @@
>> $log3->level($DEBUG);
>>
>> $log1->debug("Debug Message");
>> -ok($app->buffer(), "");
>> -ok($app2->buffer(), "");
>> -ok($app3->buffer(), "");
>> +ok($app->buffer() eq "", "app buffer is empty");
>> +ok($app2->buffer() eq "", "app2 buffer is empty");
>> +ok($app3->buffer() eq "", "app3 buffer is empty");
>>
>> ##################################################
>> # Block via 'false' additivity
>> @@ -154,9 +169,9 @@
>> $log3->level($DEBUG);
>>
>> $log1->debug("Debug Message");
>> -ok($app->buffer(), "DEBUG - Debug Message\n");
>> -ok($app2->buffer(), "DEBUG - Debug Message\n");
>> -ok($app3->buffer(), "");
>> +ok($app->buffer() eq "DEBUG - Debug Message\n", "app buffer contains
>> DEBUG");
>> +ok($app2->buffer() eq "DEBUG - Debug Message\n", "app2 buffer
>> contains DEBUG");
>> +ok($app3->buffer() eq "", "app3 buffer is empty");
>>
>> ##################################################
>> # Check is_*() functions
>> @@ -165,20 +180,20 @@
>> $log2->level($ERROR);
>> $log3->level($INFO);
>>
>> -ok($log1->is_error(), 1);
>> -ok($log1->is_info(), 1);
>> -ok($log1->is_fatal(), 1);
>> -ok($log1->is_debug(), 1);
>> -
>> -ok($log2->is_error(), 1);
>> -ok($log2->is_info(), "");
>> -ok($log2->is_fatal(), 1);
>> -ok($log2->is_debug(), "");
>> -
>> -ok($log3->is_error(), 1);
>> -ok($log3->is_info(), 1);
>> -ok($log3->is_fatal(), 1);
>> -ok($log3->is_debug(), "");
>> +ok($log1->is_error(), "log1 is_error == 1");
>> +ok($log1->is_info(), "log1 is_info == 1");
>> +ok($log1->is_fatal(), "log1 is_fatal == 1");
>> +ok($log1->is_debug(), "log1 is_debug == 1");
>> +
>> +ok($log2->is_error(), "log2 is_error == 1");
>> +ok(!$log2->is_info(), "log2 is_info == 0");
>> +ok($log2->is_fatal(), "log2 is_fatal == 1");
>> +ok(!$log2->is_debug(), "log2 is_debug == 0");
>> +
>> +ok($log3->is_error(), "log3 is_error == 1");
>> +ok($log3->is_info(), "log3 is_info == 1");
>> +ok($log3->is_fatal(), "log3 is_fatal == 1");
>> +ok(!$log3->is_debug(), "log3 is_debug == 0");
>>
>>
>> ##################################################
>> @@ -201,9 +216,12 @@
>> $log3->log($DEBUG, "debug message");
>> $log3->log($INFO, "info message ");
>>
>> -ok($app->buffer(), "DEBUG - debug message\nINFO - info message \n");
>> -ok($app2->buffer(),"DEBUG - debug message\nINFO - info message \n");
>> -ok($app3->buffer(),"INFO - info message \n");
>> +ok($app->buffer() eq "DEBUG - debug message\nINFO - info message \n",
>> + "app buffer contains DEBUG and INFO");
>> +ok($app2->buffer() eq "DEBUG - debug message\nINFO - info message \n",
>> + "app2 buffer contains DEBUG");
>> +ok($app3->buffer() eq "INFO - info message \n",
>> + "app3 buffer contains INFO");
>>
>> ##################################################
>> # Check several messages concatenated
>> @@ -219,7 +237,7 @@
>> $log1->error("9 ", "10 ");
>> $log1->fatal("11 ", "12 ", "13 ");
>>
>> -ok($app->buffer(), <<EOT);
>> +ok($app->buffer() eq <<EOT, "app buffer six lines");
>> DEBUG - 1 2 DEBUG - 3 4 INFO - 5 6 @@ -238,9 +256,11 @@
>> $log1->log($DEBUG, sub { "1" . " " . "2" } );
>> $log1->info(sub { "3 " . "4 " }, sub { "5 " . "6 " });
>>
>> -ok($app->buffer(), <<EOT);
>> +ok($app->buffer() eq <<EOT, "app buffer contains 2 lines");
>> DEBUG - 1 2
>> INFO - 3 4 5 6 EOT
>>
>> -BEGIN { plan tests => 46 };
>> +# warn("app buffer is: ", $app->buffer(), "\n");
>> +
>> +# BEGIN { plan tests => 46 };
>> Index: t/016Export.t
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/t/016Export.t,v
>> retrieving revision 1.5
>> diff -a -u -r1.5 016Export.t
>> --- t/016Export.t 4 Aug 2002 20:01:40 -0000 1.5
>> +++ t/016Export.t 9 Sep 2002 02:11:24 -0000
>> @@ -18,10 +18,10 @@
>>
>> ok(1);
>>
>> -ok($DEBUG > $ERROR);
>> -ok($INFO > $WARN);
>> -ok($WARN > $ERROR);
>> -ok($ERROR > $FATAL);
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($DEBUG, $ERROR));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($INFO, $WARN));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($WARN, $ERROR));
>> +ok(Log::Log4perl::Level::isGreaterOrEqual($ERROR, $FATAL));
>>
>> ##################################################
>> # Init logger
>> Index: t/024WarnDieCarp.t
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/t/024WarnDieCarp.t,v
>> retrieving revision 1.1
>> diff -a -u -r1.1 024WarnDieCarp.t
>> --- t/024WarnDieCarp.t 29 Aug 2002 05:33:28 -0000 1.1
>> +++ t/024WarnDieCarp.t 9 Sep 2002 02:11:25 -0000
>> @@ -46,6 +46,17 @@
>> ok($app->buffer() !~ /$out_str/, "$mname($in_str): Buffer does NOT
>> contain \"$out_str\"");
>> }
>>
>> +# same as above, just look for no output in buffer, but output in STDERR
>> +sub dietest_nooutput {
>> + my ($method, $in_str, $out_str, $app, $mname) = @_;
>> +
>> + eval { &$method($in_str) };
>> + + ok($warnstr =~ /$out_str/, "$mname($in_str): STDERR contains
>> \"$out_str\"");
>> + ok($app->buffer() !~ /$out_str/, "$mname($in_str): Buffer does NOT
>> contain \"$out_str\"");
>> +}
>> +
>> +
>> ok(1, "Initialized OK");
>> ############################################################
>> @@ -94,13 +105,12 @@
>>
>> $log->level($OFF); # $OFF == $FATAL... although I suspect that's a bug
>> in the log4j spec
>>
>> -foreach my $f ("logwarn", "logcarp", "logcluck",
>> - "error_warn", "error_die") {
>> +foreach my $f ("logwarn", "logcarp", "logcluck", "error_warn") {
>> warndietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test
>> $test: $f", $app, "$f");
>> $test++;
>> }
>>
>> -foreach my $f ("logdie", "logcroak", "logconfess") {
>> - warndietest(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f",
>> $app, "$f");
>> +foreach my $f ("error_die", "logdie", "logcroak", "logconfess") {
>> + dietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test:
>> $f", $app, "$f");
>> $test++;
>> }
>> Index: t/025CustLevels.t
>> ===================================================================
>> RCS file: /cvsroot/log4perl/Log-Log4perl/t/025CustLevels.t,v
>> retrieving revision 1.1
>> diff -a -u -r1.1 025CustLevels.t
>> --- t/025CustLevels.t 3 Sep 2002 18:09:42 -0000 1.1
>> +++ t/025CustLevels.t 9 Sep 2002 02:11:26 -0000
>> @@ -1,6 +1,7 @@
>> ###########################################
>> # Test Suite for Log::Log4perl::Config
>> -# Mike Schilli, 2002 (m...@pe...)
>> +# Erik Selberg, (c) 2002 er...@se...
>> +# clone of 025CustLevels.t but uses nicer method (?) we hope
>> ###########################################
>>
>> #########################
>> @@ -9,26 +10,61 @@
>> use Test;
>>
>> #create a custom level "LITEWARN"
>> -BEGIN {
>> -package Log::Log4perl::Level;
>> -our %PRIORITY = (
>> - "FATAL" => 0,
>> - "ERROR" => 3,
>> - "WARN" => 4,
>> - "LITEWARN" => 5,
>> - "INFO" => 6,
>> - "DEBUG" => 7,
>> -);
>> -}
>> -
>> -
>> use Log::Log4perl;
>> use Log::Log4perl::Level;
>> use Log::Log4perl::TestBuffer;
>> +# use strict;
>>
>>
>> ok(1); # If we made it this far, we're ok.
>>
>> +Log::Log4perl::Logger::create_custom_level("LITEWARN", "WARN");
>> +
>> +# test insane creation of levels
>> +
>> +foreach (1 .. 14) {
>> + ok(Log::Log4perl::Logger::create_custom_level("TEST$_", "INFO"), 0);
>> +}
>> +
>> +# 15th should fail.. this assumes that each level is 10000 apart from
>> +# the other.
>> +
>> +ok(eval { Log::Log4perl::Logger::create_custom_level("TEST15",
>> "INFO") }, + undef);
>> +
>> +# now, by re-arranging (as we whine about in create_custom_levels), we
>> +# should be able to get 15.
>> +
>> +my %btree = (
>> + 8 => "DEBUG",
>> + 4 => 8,
>> + 2 => 4,
>> + 1 => 2,
>> + 3 => 4,
>> + 6 => 8,
>> + 5 => 6,
>> + 7 => 8,
>> + 12 => "DEBUG",
>> + 10 => 12,
>> + 9 => 10,
>> + 11 => 12,
>> + 14 => "DEBUG",
>> + 13 => 14,
>> + 15 => "DEBUG",
>> + );
>> +
>> +foreach (8, 4, 2, 1, 3, 6, 5, 7, 12, 10, 9, 11, 14, 13, 15) {
>> + my $level = $btree{$_} eq "DEBUG" ? "DEBUG" : "BTREE$btree{$_}";
>> +# warn("Creating BTREE$_ after $level");
>> + ok(Log::Log4perl::Logger::create_custom_level("BTREE$_", $level), 0);
>> +# warn("BTREE$_ is ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}});
>> +}
>> +
>> +# foreach (1 .. 15) {
>> +# warn("BTREE$_ is: ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}});
>> +# }
>> +
>> +
>> my $LOGFILE = "example.log";
>> unlink $LOGFILE;
>>
>> @@ -40,10 +76,16 @@
>> EOT
>>
>>
>> -
>> Log::Log4perl::init(\$config);
>>
>>
>> +# can't create a custom level after init... let's test that. Just look
>> +# for an undef (i.e. failure) from the eval
>> +
>> +ok(eval { Log::Log4perl::Logger::create_custom_level("NOTIFY",
>> "WARN"); },
>> + undef);
>> +
>> +
>> # *********************
>> # check a category logger
>>
>> @@ -76,6 +118,7 @@
>>
>> $logger->log($WARN, "a warning message");
>> $logger->log($LITEWARN, "a LITE warning message");
>> +die("lame hack to suppress warning") if ($LITEWARN != $LITEWARN);
>> $logger->log($DEBUG, "an info message, should not log");
>>
>> open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE";
>> @@ -92,9 +135,12 @@
>> ok(! $logger->is_info);
>>
>>
>> +# warn("Testing inc_level()");
>> +
>> #***************************
>> #increase/decrease leves
>> -$logger->inc_level(); #bump up from litewarn to warn
>> +$logger->inc_level(1); #bump up from litewarn to warn
>> +# warn("level is now: ", $logger->level());
>> ok($logger->is_warn);
>> ok(!$logger->is_litewarn);
>> ok(!$logger->is_info);
>> @@ -107,14 +153,15 @@
>> my $result4 = "WARN - after bumping, warning message\n";
>> ok($data, "$result1$result2$result3$result4");
>>
>> -
>> $logger->dec_level(2); #bump down from warn to litewarn to info
>> +
>> ok($logger->is_warn);
>> ok($logger->is_litewarn);
>> ok($logger->is_info);
>> +
>> ok(! $logger->is_debug) ;
>>
>>
>> -BEGIN { plan tests => 15 };
>> +BEGIN { plan tests => 46 };
>>
>> unlink $LOGFILE;
>>
>>
>
>
>
--
Happy Trails . . .
Kevin M. Goess
(and Anne and Frank)
904 Carmel Ave.
Albany, CA 94706
(510) 525-5217
|
