r63602 - in /branches/upstream/liblog-handler-perl/current: ChangeLog META.yml examples/benchmark/benchmark.pl lib/Log/Handler.pm t/019-handler-setlevel.t
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Mon Oct 11 13:58:36 UTC 2010
Author: ansgar
Date: Mon Oct 11 13:58:21 2010
New Revision: 63602
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=63602
Log:
[svn-upgrade] new version liblog-handler-perl (0.67)
Modified:
branches/upstream/liblog-handler-perl/current/ChangeLog
branches/upstream/liblog-handler-perl/current/META.yml
branches/upstream/liblog-handler-perl/current/examples/benchmark/benchmark.pl
branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm
branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t
Modified: branches/upstream/liblog-handler-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/ChangeLog?rev=63602&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/ChangeLog (original)
+++ branches/upstream/liblog-handler-perl/current/ChangeLog Mon Oct 11 13:58:21 2010
@@ -1,3 +1,8 @@
+0.67 Released at 2010-10-10.
+ - Fixed a bug in set_level. The new level was set correctly
+ but no message was logged because the output wasn't added
+ to the $self->{levels} array.
+
0.66 Released at 2010-09-27.
- Roled back again to 0.65 for different reasons.
- Fixed some spelling error in POD (RT #60005).
Modified: branches/upstream/liblog-handler-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/META.yml?rev=63602&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/META.yml (original)
+++ branches/upstream/liblog-handler-perl/current/META.yml Mon Oct 11 13:58:21 2010
@@ -1,6 +1,6 @@
---
name: Log-Handler
-version: 0.66
+version: 0.67
author:
- Jonny Schulz
abstract: Log messages to several outputs.
@@ -29,7 +29,7 @@
provides:
Log::Handler:
file: lib/Log/Handler.pm
- version: 0.66
+ version: 0.67
Log::Handler::Config:
file: lib/Log/Handler/Config.pm
version: 0.07
Modified: branches/upstream/liblog-handler-perl/current/examples/benchmark/benchmark.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/examples/benchmark/benchmark.pl?rev=63602&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/examples/benchmark/benchmark.pl (original)
+++ branches/upstream/liblog-handler-perl/current/examples/benchmark/benchmark.pl Mon Oct 11 13:58:21 2010
@@ -29,26 +29,18 @@
use Log::Handler;
use Benchmark;
-my $BUFFER;
-sub buffer {
- $BUFFER .= shift->{message};
-}
+sub buffer { }
+my $log1 = Log::Handler->new(); # simple pattern
+my $log2 = Log::Handler->new(); # default pattern & suppressed
+my $log3 = Log::Handler->new(); # complex pattern
+my $log4 = Log::Handler->new(); # message pattern
+my $log5 = Log::Handler->new(); # filtered caller
+my $log6 = Log::Handler->new(); # filtered message
+my $log7 = Log::Handler->new(); # categories
-my $log = Log::Handler->new();
-
-$log->add(
+$log1->add(
forward => {
- alias => 'complex',
- maxlevel => 'info',
- minlevel => 'info',
- forward_to => \&buffer,
- message_layout => '%T [%L] %H(%P) %m (%C)%N',
- }
-);
-
-$log->add(
- forward => {
- alias => 'simple',
+ alias => 'simple pattern',
maxlevel => 'notice',
minlevel => 'notice',
newline => 1,
@@ -57,9 +49,9 @@
}
);
-$log->add(
+$log2->add(
forward => {
- alias => 'default & suppressed',
+ alias => 'default pattern & suppressed',
maxlevel => 'warning',
minlevel => 'warning',
newline => 1,
@@ -67,7 +59,17 @@
}
);
-$log->add(
+$log3->add(
+ forward => {
+ alias => 'complex pattern',
+ maxlevel => 'info',
+ minlevel => 'info',
+ forward_to => \&buffer,
+ message_layout => '%T [%L] %H(%P) %m (%C)%N',
+ }
+);
+
+$log4->add(
forward => {
alias => 'message pattern',
maxlevel => 'error',
@@ -79,20 +81,42 @@
}
);
-$log->add(
+$log5->add(
forward => {
- alias => 'filter caller',
+ alias => 'filtered caller',
maxlevel => 'emerg',
minlevel => 'emerg',
newline => 1,
forward_to => \&buffer,
- filter_caller => qr/^Foo::Bar\z/,
+ filter_caller => qr/^Foo\z/,
}
);
-$log->add(
+$log5->add(
forward => {
- alias => 'filter message',
+ alias => 'filtered caller',
+ maxlevel => 'emerg',
+ minlevel => 'emerg',
+ newline => 1,
+ forward_to => \&buffer,
+ filter_caller => qr/^Bar\z/,
+ }
+);
+
+$log5->add(
+ forward => {
+ alias => 'filtered caller',
+ maxlevel => 'emerg',
+ minlevel => 'emerg',
+ newline => 1,
+ forward_to => \&buffer,
+ filter_caller => qr/^Baz\z/,
+ }
+);
+
+$log6->add(
+ forward => {
+ alias => 'filtered message',
maxlevel => 'alert',
minlevel => 'alert',
newline => 1,
@@ -101,31 +125,67 @@
}
);
+$log7->add(
+ forward => {
+ alias => 'category',
+ maxlevel => 'emerg',
+ minlevel => 'emerg',
+ newline => 1,
+ forward_to => \&buffer,
+ category => "Foo",
+ }
+);
+
+$log7->add(
+ forward => {
+ alias => 'category',
+ maxlevel => 'emerg',
+ minlevel => 'emerg',
+ newline => 1,
+ forward_to => \&buffer,
+ category => "Bar",
+ }
+);
+
+$log7->add(
+ forward => {
+ alias => 'category',
+ maxlevel => 'emerg',
+ minlevel => 'emerg',
+ newline => 1,
+ forward_to => \&buffer,
+ category => "Baz",
+ }
+);
+
my $count = 100_000;
my $message = 'foo bar baz';
-run("simple pattern output took", $count, sub { $log->notice($message) } );
-run("default pattern output took", $count, sub { $log->warning($message) } );
-run("complex pattern output took", $count, sub { $log->info($message) } );
-run("message pattern output took", $count, sub { $log->error($message) } );
-run("suppressed output took", $count, sub { $log->debug($message) } );
-run("filtered caller output took", $count, \&Foo::Bar::emerg );
-run("suppressed caller output took", $count, \&Foo::Baz::emerg );
-run("filtered messages output took", $count, sub { $log->alert($message) } );
+run("simple pattern output took", $count, sub { $log1->notice($message) } );
+run("default pattern output took", $count, sub { $log2->warning($message) } );
+run("complex pattern output took", $count, sub { $log3->info($message) } );
+run("message pattern output took", $count, sub { $log4->error($message) } );
+run("suppressed output took", $count, sub { $log2->debug($message) } );
+run("filtered caller output took", $count, \&Foo::emerg );
+run("suppressed caller output took", $count, \&Foo::Bar::emerg );
+run("filtered messages output took", $count, sub { $log6->alert($message) } );
+run("category output took", $count, \&Foo::Bar::Baz::emerg );
sub run {
my ($desc, $count, $bench) = @_;
my $time = timeit($count, $bench);
print sprintf('%-30s', $desc), ' : ', timestr($time), "\n";
- undef $BUFFER;
}
# Filter messages by caller
-package Foo::Bar;
-sub emerg { $log->emerg($message) }
+package Foo;
+sub emerg { $log5->emerg($message) }
# Suppressed messages by caller
-package Foo::Baz;
-sub emerg { $log->emerg($message) }
+package Foo::Bar;
+sub emerg { $log5->emerg($message) }
+
+package Foo::Bar::Baz;
+sub emerg { $log7->emerg($message) }
1;
Modified: branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm?rev=63602&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm Mon Oct 11 13:58:21 2010
@@ -1051,7 +1051,7 @@
use UNIVERSAL;
use base qw(Log::Handler::Levels);
-our $VERSION = "0.66";
+our $VERSION = "0.67";
our $ERRSTR = "";
# $TRACE and $CALLER_LEVEL are both used as global
@@ -1421,6 +1421,7 @@
foreach my $level (keys %{$output->{levels}}) {
if ($levels->{$level}) {
my @old_order = @{$levels->{$level}};
+ push @old_order, $output;
$levels->{$level} = [
map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
Modified: branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t?rev=63602&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t (original)
+++ branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t Mon Oct 11 13:58:21 2010
@@ -9,28 +9,74 @@
$MESSAGE++;
}
-ok(1, 'use');
+ok(1, "use");
my $log = Log::Handler->new();
$log->add(
forward => {
- alias => 'forward1',
+ alias => "forward0",
forward_to => \&test,
- minlevel => 'emerg',
- maxlevel => 'error',
+ minlevel => "emerg",
+ maxlevel => "error",
}
);
-$log->error();
+$log->add(
+ forward => {
+ alias => "forward1",
+ forward_to => \&test,
+ minlevel => "emerg",
+ maxlevel => "error",
+ }
+);
+
+$log->add(
+ forward => {
+ alias => "forward2",
+ forward_to => \&test,
+ minlevel => "emerg",
+ maxlevel => "error",
+ }
+);
+
+# should log nothing
+$log->notice();
$log->set_level(
forward1 => {
- minlevel => 'emerg',
- maxlevel => 'alert',
+ minlevel => "emerg",
+ maxlevel => "debug",
}
);
-$log->error();
+# should only forward1 should log
+$log->debug();
-ok($MESSAGE == 1, "check set_level($MESSAGE)");
+# disable logging for forward1 and
+# enable it for forward0 and forward2
+$log->set_level(
+ forward0 => {
+ minlevel => "emerg",
+ maxlevel => "debug",
+ }
+);
+
+$log->set_level(
+ forward1 => {
+ minlevel => "emerg",
+ maxlevel => "error",
+ }
+);
+
+$log->set_level(
+ forward2 => {
+ minlevel => "emerg",
+ maxlevel => "debug",
+ }
+);
+
+# should only log to forward0 and forward2
+$log->debug();
+
+ok($MESSAGE == 3, "check set_level($MESSAGE)");
More information about the Pkg-perl-cvs-commits
mailing list