r23567 - in /trunk/liblog-handler-perl: ./ debian/ lib/Log/ lib/Log/Handler/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Jul 26 14:51:29 UTC 2008
Author: gregoa
Date: Sat Jul 26 14:51:26 2008
New Revision: 23567
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=23567
Log:
New upstream release.
Added:
trunk/liblog-handler-perl/t/015-handler-filter-caller.t
- copied unchanged from r23566, branches/upstream/liblog-handler-perl/current/t/015-handler-filter-caller.t
trunk/liblog-handler-perl/t/015-handler-filter-message.t
- copied unchanged from r23566, branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t
Removed:
trunk/liblog-handler-perl/t/015-handler-filter.t
Modified:
trunk/liblog-handler-perl/Build.PL
trunk/liblog-handler-perl/ChangeLog
trunk/liblog-handler-perl/MANIFEST
trunk/liblog-handler-perl/META.yml
trunk/liblog-handler-perl/README
trunk/liblog-handler-perl/debian/changelog
trunk/liblog-handler-perl/lib/Log/Handler.pm
trunk/liblog-handler-perl/lib/Log/Handler/Changes.pod
trunk/liblog-handler-perl/lib/Log/Handler/Examples.pod
trunk/liblog-handler-perl/lib/Log/Handler/Levels.pm
trunk/liblog-handler-perl/lib/Log/Handler/Output.pm
trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm
Modified: trunk/liblog-handler-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/Build.PL?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/Build.PL (original)
+++ trunk/liblog-handler-perl/Build.PL Sat Jul 26 14:51:26 2008
@@ -18,7 +18,7 @@
'YAML' => 0,
},
requires => {
- 'perl' => '5.6.1',
+ 'perl' => '5.006_001',
'Carp' => 0,
'Data::Dumper' => 0,
'Devel::Backtrace' => 0.05,
@@ -32,4 +32,5 @@
'UNIVERSAL::require' => 0,
},
);
+
$build->create_build_script;
Modified: trunk/liblog-handler-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/ChangeLog?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/ChangeLog (original)
+++ trunk/liblog-handler-perl/ChangeLog Sat Jul 26 14:51:26 2008
@@ -1,3 +1,11 @@
+0.45 Released at 2008-07-25.
+ - Kicked $self->{caller_level} and replaced it with
+ Log::Handler::CALLER_LEVEL. The reason is that if dump(),
+ die() or warn() was called then the patterns %p, %f, %c or
+ %s was wrong.
+ - Changed option filter to filter_message and added a new
+ option called filter_caller.
+
0.44 Released at 2008-06-04.
- Fixed set_pattern(). It dies if the key name is something like
'x-name' because $m->{x-name} is not valid.
@@ -278,4 +286,4 @@
- Changed the POD.
0.01 Released at 2007-02-04.
-x.xx Thanks to Larry Wall and all other Perl developer for Perl :-)
+x.xx Thanks to Larry Wall and all other Perl developers for Perl :-)
Modified: trunk/liblog-handler-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/MANIFEST?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/MANIFEST (original)
+++ trunk/liblog-handler-perl/MANIFEST Sat Jul 26 14:51:26 2008
@@ -38,7 +38,8 @@
t/012-handler-message-pattern.t
t/013-handler-priority.t
t/014-handler-prepare.t
-t/015-handler-filter.t
+t/015-handler-filter-caller.t
+t/015-handler-filter-message.t
t/016-handler-alias.t
t/017-handler-special-levels.t
t/020-output-forward.t
Modified: trunk/liblog-handler-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/META.yml?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/META.yml (original)
+++ trunk/liblog-handler-perl/META.yml Sat Jul 26 14:51:26 2008
@@ -1,6 +1,6 @@
---
name: Log-Handler
-version: 0.44
+version: 0.45
author:
- Jonny Schulz
abstract: Log messages to several outputs.
@@ -19,7 +19,7 @@
Test::More: 0
Time::HiRes: 0
UNIVERSAL::require: 0
- perl: 5.6.1
+ perl: 5.006_001
recommends:
Config::General: 0
Config::Properties: 0
@@ -30,16 +30,16 @@
provides:
Log::Handler:
file: lib/Log/Handler.pm
- version: 0.44
+ version: 0.45
Log::Handler::Config:
file: lib/Log/Handler/Config.pm
version: 0.03
Log::Handler::Levels:
file: lib/Log/Handler/Levels.pm
- version: 0.03
+ version: 0.04
Log::Handler::Output:
file: lib/Log/Handler/Output.pm
- version: 0.03
+ version: 0.04
Log::Handler::Output::DBI:
file: lib/Log/Handler/Output/DBI.pm
version: 0.03
@@ -60,7 +60,7 @@
version: 0.04
Log::Handler::Pattern:
file: lib/Log/Handler/Pattern.pm
- version: 0.02
+ version: 0.03
Log::Handler::Plugin::Config::General:
file: lib/Log/Handler/Plugin/Config/General.pm
version: 0.02
Modified: trunk/liblog-handler-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/README?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/README (original)
+++ trunk/liblog-handler-perl/README Sat Jul 26 14:51:26 2008
@@ -269,7 +269,7 @@
# or Log::Handler::errstr()
# or $Log::Handler::ERRSTR
- filter
+ filter_message
With this option it's possible to set a filter. If the filter is set
then only messages will be logged that match the filter. You can
pass a regexp, a code reference or a simple string. Example:
@@ -279,7 +279,10 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => qr/log this/, # log only messages that contain 'log this'
+ filter_message => qr/log this/,
+ # or
+ # filter_message => 'log this',
+ # filter_message => '^log only this$',
});
$log->info('log this');
@@ -293,7 +296,7 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => \&my_filter
+ filter_message => \&my_filter
});
# return TRUE if you want to log the message, FALSE if not
@@ -311,7 +314,7 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => {
+ filter_message => {
match1 => 'log this',
match2 => qr/with that/,
match3 => '(?:or this|or that)',
@@ -324,6 +327,32 @@
match1 => '(?{unlink("file.txt")})'
would cause an error!
+
+ "filter_caller"
+ You can use this option to set a package name. Only messages from
+ this packages will be logged.
+
+ Example:
+
+ my $log = Log::Handler->new();
+
+ $log->add(screen => {
+ maxlevel => 'info',
+ newline => 1,
+ filter_caller => qr/^Foo::Bar$/,
+ # or
+ # filter_caller => '^Foo::Bar$',
+ });
+
+ package Foo::Bar;
+ $log->info('log this');
+
+ package Foo::Baz;
+ $log->info('but not that');
+
+ 1;
+
+ This would only log the message from the package "Foo::Bar".
alias
You can set an alias if you want to get the output object later.
Modified: trunk/liblog-handler-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/debian/changelog?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/debian/changelog (original)
+++ trunk/liblog-handler-perl/debian/changelog Sat Jul 26 14:51:26 2008
@@ -1,3 +1,9 @@
+liblog-handler-perl (0.45-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Sat, 26 Jul 2008 16:50:01 +0200
+
liblog-handler-perl (0.44-1) unstable; urgency=low
* New upstream release.
Modified: trunk/liblog-handler-perl/lib/Log/Handler.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler.pm?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler.pm Sat Jul 26 14:51:26 2008
@@ -277,7 +277,7 @@
# or Log::Handler::errstr()
# or $Log::Handler::ERRSTR
-=item B<filter>
+=item B<filter_message>
With this option it's possible to set a filter. If the filter is set then
only messages will be logged that match the filter. You can pass a regexp,
@@ -288,7 +288,10 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => qr/log this/, # log only messages that contain 'log this'
+ filter_message => qr/log this/,
+ # or
+ # filter_message => 'log this',
+ # filter_message => '^log only this$',
});
$log->info('log this');
@@ -301,7 +304,7 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => \&my_filter
+ filter_message => \&my_filter
});
# return TRUE if you want to log the message, FALSE if not
@@ -318,7 +321,7 @@
mode => 'append',
newline => 1,
maxlevel => 6,
- filter => {
+ filter_message => {
match1 => 'log this',
match2 => qr/with that/,
match3 => '(?:or this|or that)',
@@ -331,6 +334,33 @@
match1 => '(?{unlink("file.txt")})'
would cause an error!
+
+=item C<filter_caller>
+
+You can use this option to set a package name. Only messages from this
+packages will be logged.
+
+Example:
+
+ my $log = Log::Handler->new();
+
+ $log->add(screen => {
+ maxlevel => 'info',
+ newline => 1,
+ filter_caller => qr/^Foo::Bar$/,
+ # or
+ # filter_caller => '^Foo::Bar$',
+ });
+
+ package Foo::Bar;
+ $log->info('log this');
+
+ package Foo::Baz;
+ $log->info('but not that');
+
+ 1;
+
+This would only log the message from the package C<Foo::Bar>.
=item B<alias>
@@ -819,12 +849,21 @@
use Log::Handler::Pattern;
use base qw(Log::Handler::Levels);
-our $VERSION = '0.44';
+our $VERSION = '0.45';
our $ERRSTR = '';
-# turn on/off tracing
-our $TRACE = 0;
-
+# $TRACE and $CALLER_LEVEL are both used as global
+# variables in other packages as well. You shouldn't
+# manipulate them if you don't know what you do.
+#
+# $TRACE is used to turn on/off tracing.
+#
+# $CALLER_LEVEL is used to determine the current
+# caller level
+our $CALLER_LEVEL = 0;
+our $TRACE = 0;
+
+# Some constants...
use constant PRIORITY => 10;
use constant BOOL_RX => qr/^[01]\z/;
use constant NUMB_RX => qr/^\d+\z/;
@@ -1056,6 +1095,8 @@
debug_trace
die_on_errors
filter
+ filter_message
+ filter_caller
maxlevel
message_layout
message_pattern
@@ -1118,11 +1159,15 @@
}
sub _validate_options {
- my $self = shift;
+ my ($self, @args) = @_;
my $pattern = $self->{pattern};
my (%wanted, $is_fatal);
- my %options = Params::Validate::validate(@_, {
+ if (exists $args[0]{filter}) {
+ $args[0]{filter_message} = delete $args[0]{filter};
+ }
+
+ my %options = Params::Validate::validate(@args, {
timeformat => {
type => Params::Validate::SCALAR,
default => '%b %d %H:%M:%S',
@@ -1188,22 +1233,21 @@
type => Params::Validate::SCALAR,
optional => 1,
},
- filter => {
+ filter_message => {
type => Params::Validate::SCALAR # 'foo'
| Params::Validate::SCALARREF # qr/foo/
| Params::Validate::CODEREF # sub { shift->{message} =~ /foo/ }
| Params::Validate::HASHREF, # matchN, condition
optional => 1,
},
- caller_level => {
- type => Params::Validate::SCALAR,
- regex => NUMB_RX,
- default => 2,
+ filter_caller => {
+ type => Params::Validate::SCALAR | Params::Validate::SCALARREF,
+ optional => 1,
},
});
- if ($options{filter}) {
- $options{filter} = $self->_validate_filter($options{filter});
+ if ($options{filter_message}) {
+ $options{filter_message} = $self->_validate_filter($options{filter_message});
}
# set a default priority if not set
Modified: trunk/liblog-handler-perl/lib/Log/Handler/Changes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Changes.pod?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Changes.pod (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Changes.pod Sat Jul 26 14:51:26 2008
@@ -1,6 +1,6 @@
=head1 NAME
-Log::Handler::Changes - Changes from 0.38 to 0.42.
+Log::Handler::Changes - Changes from 0.38 to 0.45.
=head1 WHAT IS NEW, WHAT IS DEPRECATED
@@ -51,7 +51,8 @@
priority
message_pattern
prepare_message
- filter
+ filter_message
+ filter_caller
alias
=head2 Changed options
Modified: trunk/liblog-handler-perl/lib/Log/Handler/Examples.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Examples.pod?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Examples.pod (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Examples.pod Sat Jul 26 14:51:26 2008
@@ -208,7 +208,7 @@
# log to error.log and to foo at bar.example
$log->emergency("this is a emergency message");
-=head1 FILTER
+=head1 FILTER MESSAGES
my $log = Log::Handler->new();
@@ -216,7 +216,7 @@
screen => {
newline => 1,
maxlevel => 6,
- filter => {
+ filter_message => {
match1 => 'foo',
match2 => 'bar',
match3 => 'baz',
@@ -229,21 +229,56 @@
$log->info('foo bar');
$log->info('foo baz');
+=head2 FILTER CALLER
+
+This example shows you how it's possilbe to debug messages
+only from a special namespace.
+
+ my $log = Log::Handler->new();
+
+ $log->add(
+ file => {
+ filename => 'file1.log',
+ mode => 'append',
+ newline => 1,
+ maxlevel => 'warning',
+ }
+ );
+
+ $log->add(
+ screen => {
+ maxlevel => 'debug',
+ newline => 1,
+ message_layout => 'message from %p - %m',
+ filter_caller => qr/^Foo::Bar\z/,
+ }
+ );
+
+ $log->warning('a warning here');
+
+ package Foo::Bar;
+ $log->info('an info here');
+ 1;
+
=head2 ANOTHER FILTER
- filter => 'as string'
-
- filter => qr/as regexp/
-
- filter => sub { shift->{message} =~ /as code ref/ }
+ filter_message => 'as string'
+
+ filter_message => qr/as regexp/
+
+ filter_message => sub { shift->{message} =~ /as code ref/ }
# or with conditions
- filter => {
+ filter_message => {
match1 => 'as string',
match2 => qr/as regexp/',
condition => 'match1 || match2',
}
+
+ filter_caller => 'as string'
+
+ filter_caller => qr/as regexp/
=head1 CONFIG
Modified: trunk/liblog-handler-perl/lib/Log/Handler/Levels.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Levels.pm?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Levels.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Levels.pm Sat Jul 26 14:51:26 2008
@@ -158,7 +158,7 @@
use Carp;
use Data::Dumper;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
my %LEVELS_BY_ROUTINE = (
debug => 'DEBUG',
@@ -227,6 +227,7 @@
if (!exists $LEVELS_BY_ROUTINE{$level}) {
$level = 'debug';
}
+ local $Log::Handler::CALLER_LEVEL = 1;
local $Log::Handler::TRACE = 1;
return $self->$level(@_);
}
@@ -237,6 +238,7 @@
if (!exists $LEVELS_BY_ROUTINE{$level}) {
$level = 'emergency';
}
+ local $Log::Handler::CALLER_LEVEL = 1;
my @caller = caller;
$self->$level(@_, "at line $caller[2]");
Carp::croak @_;
@@ -248,6 +250,7 @@
if (!exists $LEVELS_BY_ROUTINE{$level}) {
$level = 'debug';
}
+ local $Log::Handler::CALLER_LEVEL = 1;
return $self->$level(Dumper(@_));
}
Modified: trunk/liblog-handler-perl/lib/Log/Handler/Output.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Output.pm?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Output.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Output.pm Sat Jul 26 14:51:26 2008
@@ -43,7 +43,7 @@
use UNIVERSAL;
use Devel::Backtrace;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
our $ERRSTR = '';
sub new {
@@ -60,6 +60,11 @@
my $output = $self->{output};
my $pattern = $self->{pattern};
my $message = { };
+
+ if ($self->{filter_caller}) {
+ my $caller = (caller(1+$Log::Handler::CALLER_LEVEL))[0];
+ return 1 if $caller !~ $self->{filter_caller};
+ }
foreach my $r (@{$self->{wanted_pattern}}) {
if (ref($r->{code})) {
@@ -85,8 +90,8 @@
$message->{message} .= "\n";
}
- if ($self->{filter}) {
- $self->_filter_ok($message) or return 1;
+ if ($self->{filter_message}) {
+ $self->_filter_msg($message) or return 1;
}
if ($self->{prepare_message}) {
@@ -154,9 +159,9 @@
return $@ ? $self->_raise_error($@) : $msg;
}
-sub _filter_ok {
+sub _filter_msg {
my ($self, $message) = @_;
- my $filter = $self->{filter};
+ my $filter = $self->{filter_message};
my $result = $filter->{result};
my $code = $filter->{code};
my $return = ();
Modified: trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm?rev=23567&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm Sat Jul 26 14:51:26 2008
@@ -41,7 +41,7 @@
use Log::Handler::Output;
use constant START_TIME => scalar Time::HiRes::gettimeofday;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
my $progname = $0;
$progname =~ s at .*[/\\]@@;
@@ -90,11 +90,11 @@
sub _get_time { POSIX::strftime($_[0]->{timeformat}, localtime) }
sub _get_date { POSIX::strftime($_[0]->{dateformat}, localtime) }
sub _get_pid { $$ }
-sub _get_caller { my @c = caller($_[0]->{caller_level}); "$c[1], line $c[2]" }
-sub _get_c_pkg { (caller($_[0]->{caller_level}))[0] }
-sub _get_c_file { (caller($_[0]->{caller_level}))[1] }
-sub _get_c_line { (caller($_[0]->{caller_level}))[2] }
-sub _get_c_sub { (caller($_[0]->{caller_level}))[3] }
+sub _get_caller { my @c = caller(2+$Log::Handler::CALLER_LEVEL); "$c[1], line $c[2]" }
+sub _get_c_pkg { (caller(2+$Log::Handler::CALLER_LEVEL))[0] }
+sub _get_c_file { (caller(2+$Log::Handler::CALLER_LEVEL))[1] }
+sub _get_c_line { (caller(2+$Log::Handler::CALLER_LEVEL))[2] }
+sub _get_c_sub { (caller(2+$Log::Handler::CALLER_LEVEL))[3] }
sub _get_runtime { return sprintf('%.6f', Time::HiRes::gettimeofday - START_TIME) }
sub _get_hires {
More information about the Pkg-perl-cvs-commits
mailing list