r36346 - in /branches/upstream/liblog-handler-perl/current: ChangeLog MANIFEST META.yml Makefile.PL README examples/prepare/prepare.pl examples/text-csv/ examples/text-csv/log-as-csv-string.pl lib/Log/Handler.pm t/019-handler-setlevel.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun May 24 23:07:26 UTC 2009
Author: ansgar-guest
Date: Sun May 24 23:07:22 2009
New Revision: 36346
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=36346
Log:
[svn-upgrade] Integrating new upstream version, liblog-handler-perl (0.52)
Added:
branches/upstream/liblog-handler-perl/current/examples/text-csv/
branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl (with props)
branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t
Modified:
branches/upstream/liblog-handler-perl/current/ChangeLog
branches/upstream/liblog-handler-perl/current/MANIFEST
branches/upstream/liblog-handler-perl/current/META.yml
branches/upstream/liblog-handler-perl/current/Makefile.PL
branches/upstream/liblog-handler-perl/current/README
branches/upstream/liblog-handler-perl/current/examples/prepare/prepare.pl
branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm
Modified: branches/upstream/liblog-handler-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/ChangeLog?rev=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/ChangeLog (original)
+++ branches/upstream/liblog-handler-perl/current/ChangeLog Sun May 24 23:07:22 2009
@@ -1,3 +1,13 @@
+0.52 Released at 2009-05-24.
+ - No changes, just a full version.
+
+0.51_01 Released at 2009-05-22.
+ - Added method set_level() to Handler.pm to change the log
+ level at runtime.
+
+0.51 Released at 2009-03-07.
+ - Just a full release.
+
0.50_01 Released at 2009-03-07.
- Fixed a bug in the output DBI.pm - if the connection to
the database was lost then the message lost as well even
Modified: branches/upstream/liblog-handler-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/MANIFEST?rev=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/MANIFEST (original)
+++ branches/upstream/liblog-handler-perl/current/MANIFEST Sun May 24 23:07:22 2009
@@ -16,6 +16,7 @@
examples/prepare/prepare.pl
examples/socket/client.pl
examples/socket/server.pl
+examples/text-csv/log-as-csv-string.pl
INSTALL
lib/Log/Handler.pm
lib/Log/Handler/Config.pm
@@ -50,6 +51,7 @@
t/016-handler-alias.t
t/017-handler-special-levels.t
t/018-handler-logger.t
+t/019-handler-setlevel.t
t/020-output-forward.t
t/030-output-file.t
t/040-output-email.t
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=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/META.yml (original)
+++ branches/upstream/liblog-handler-perl/current/META.yml Sun May 24 23:07:22 2009
@@ -1,6 +1,6 @@
---
name: Log-Handler
-version: 0.51
+version: 0.52
author:
- Jonny Schulz
abstract: Log messages to several outputs.
@@ -30,7 +30,7 @@
provides:
Log::Handler:
file: lib/Log/Handler.pm
- version: 0.51
+ version: 0.52
Log::Handler::Config:
file: lib/Log/Handler/Config.pm
version: 0.04
Modified: branches/upstream/liblog-handler-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/Makefile.PL?rev=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/Makefile.PL (original)
+++ branches/upstream/liblog-handler-perl/current/Makefile.PL Sun May 24 23:07:22 2009
@@ -5,17 +5,17 @@
'NAME' => 'Log::Handler',
'VERSION_FROM' => 'lib/Log/Handler.pm',
'PREREQ_PM' => {
- 'Carp' => '0',
- 'Data::Dumper' => '0',
+ 'Carp' => 0,
+ 'Data::Dumper' => 0,
'Devel::Backtrace' => '0.05',
- 'Fcntl' => '0',
- 'File::Spec' => '0',
- 'POSIX' => '0',
- 'Params::Validate' => '0',
- 'Sys::Hostname' => '0',
- 'Test::More' => '0',
- 'Time::HiRes' => '0',
- 'UNIVERSAL::require' => '0'
+ 'Fcntl' => 0,
+ 'File::Spec' => 0,
+ 'POSIX' => 0,
+ 'Params::Validate' => 0,
+ 'Sys::Hostname' => 0,
+ 'Test::More' => 0,
+ 'Time::HiRes' => 0,
+ 'UNIVERSAL::require' => 0
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => []
Modified: branches/upstream/liblog-handler-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/README?rev=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/README (original)
+++ branches/upstream/liblog-handler-perl/current/README Sun May 24 23:07:22 2009
@@ -136,11 +136,13 @@
This option is not used by default.
newline
- Option "newline" is a very helpful option. It let the logger appends
- a newline to the message if a newline doesn't exist.
+ "newline" is a very helpful option. It let the logger appends a
+ newline to the message if a newline doesn't exist.
0 - do nothing (default)
1 - append a newline if not exist
+
+ Example:
$log->add(
screen => {
@@ -272,14 +274,15 @@
$log->add(
screen => {
newline => 1,
+ message_layout => '%m (%t)',
message_pattern => [ qw/%T %L %H %m/ ],
prepare_message => \&format,
}
);
- $log->error("foo bar baz");
- $log->error("foo bar baz");
- $log->error("foo bar baz");
+ $log->error("foo");
+ $log->error("bar");
+ $log->error("baz");
sub format {
my $m = shift;
@@ -290,9 +293,9 @@
The output looks like
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
+ Mar 08 15:14:20 ERROR h1434036 foo (0.039694)
+ Mar 08 15:14:20 ERROR h1434036 bar (0.000510)
+ Mar 08 15:14:20 ERROR h1434036 baz (0.000274)
priority
With this option you can set the priority of your output objects.
@@ -421,7 +424,7 @@
This would only log the message from the package "Foo::Bar".
except_caller
- This options is just the opposite of "filter_caller".
+ This option is just the opposite of "filter_caller".
If you want to log messages from all callers but "Foo::Bar":
@@ -784,6 +787,19 @@
Note: valid character for the key name are: "[%\w\-\.]+"
+ set_level()
+ With this method it's possible to change the log level at runtime.
+
+ To change the log level it's neccessary to use a alias - see option
+ "alias".
+
+ $log->set_level(
+ $alias => { # option alias
+ minlevel => $new_minlevel,
+ maxlevel => $new_maxlevel,
+ }
+ );
+
create_logger()
"create_logger()" is the same like "new()" but it creates a global
logger.
@@ -806,7 +822,7 @@
Or
- my @logger = Log::Handler->create_logger('myapp1', 'myapp2', ...);
+ my @logger = Log::Handler->get_logger('myapp1', 'myapp2', ...);
GLOBAL LOG HANDLER
Since version 0.50 it's possible to define a application logger. This
@@ -821,8 +837,8 @@
If the alias doesn't exists then a new "Log::Handler" object will be
created.
- If no acesseor is set then no accessor is exported into the namespace of
- the caller.
+ If no accesseor is set then no accessor is exported into the namespace
+ of the caller.
Example:
Modified: branches/upstream/liblog-handler-perl/current/examples/prepare/prepare.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/examples/prepare/prepare.pl?rev=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/examples/prepare/prepare.pl (original)
+++ branches/upstream/liblog-handler-perl/current/examples/prepare/prepare.pl Sun May 24 23:07:22 2009
@@ -34,6 +34,7 @@
$log->add(
screen => {
newline => 1,
+ message_layout => '%m (%t)',
message_pattern => [ qw/%T %L %H %m/ ],
prepare_message => \&format,
}
Added: branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl?rev=36346&op=file
==============================================================================
--- branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl (added)
+++ branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl Sun May 24 23:07:22 2009
@@ -1,0 +1,27 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Log::Handler;
+use Text::CSV;
+
+my $log = Log::Handler->new();
+my $csv = Text::CSV->new();
+
+$log->add(
+ screen => {
+ maxlevel => 'info',
+ newline => 1,
+ message_layout => '%m',
+ message_pattern => '%T %L %P %t',
+ prepare_message => sub {
+ my $m = shift;
+ $csv->combine(@{$m}{qw/time level pid mtime message/});
+ $m->{message} = $csv->string;
+ },
+ }
+);
+
+$log->info('foo');
+$log->info('bar');
+$log->info('baz');
+
Propchange: branches/upstream/liblog-handler-perl/current/examples/text-csv/log-as-csv-string.pl
------------------------------------------------------------------------------
svn:executable = *
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=36346&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm Sun May 24 23:07:22 2009
@@ -145,12 +145,13 @@
=item B<newline>
-Option C<newline> is a very helpful option. It let the logger appends a newline to
+C<newline> is a very helpful option. It let the logger appends a newline to
the message if a newline doesn't exist.
0 - do nothing (default)
1 - append a newline if not exist
+Example:
$log->add(
screen => {
@@ -283,14 +284,15 @@
$log->add(
screen => {
newline => 1,
+ message_layout => '%m (%t)',
message_pattern => [ qw/%T %L %H %m/ ],
prepare_message => \&format,
}
);
- $log->error("foo bar baz");
- $log->error("foo bar baz");
- $log->error("foo bar baz");
+ $log->error("foo");
+ $log->error("bar");
+ $log->error("baz");
sub format {
my $m = shift;
@@ -301,9 +303,9 @@
The output looks like
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
- Mar 07 20:06:39 ERROR h1434036 Mar 07 20:06:39 [ERROR] foo bar baz
+ Mar 08 15:14:20 ERROR h1434036 foo (0.039694)
+ Mar 08 15:14:20 ERROR h1434036 bar (0.000510)
+ Mar 08 15:14:20 ERROR h1434036 baz (0.000274)
=item B<priority>
@@ -433,7 +435,7 @@
=item B<except_caller>
-This options is just the opposite of C<filter_caller>.
+This option is just the opposite of C<filter_caller>.
If you want to log messages from all callers but C<Foo::Bar>:
@@ -823,6 +825,19 @@
Note: valid character for the key name are: C<[%\w\-\.]+>
+=head2 set_level()
+
+With this method it's possible to change the log level at runtime.
+
+To change the log level it's neccessary to use a alias - see option C<alias>.
+
+ $log->set_level(
+ $alias => { # option alias
+ minlevel => $new_minlevel,
+ maxlevel => $new_maxlevel,
+ }
+ );
+
=head2 create_logger()
C<create_logger()> is the same like C<new()> but it creates a global
@@ -847,7 +862,7 @@
Or
- my @logger = Log::Handler->create_logger('myapp1', 'myapp2', ...);
+ my @logger = Log::Handler->get_logger('myapp1', 'myapp2', ...);
=head1 GLOBAL LOG HANDLER
@@ -863,7 +878,7 @@
If the alias doesn't exists then a new C<Log::Handler> object
will be created.
-If no acesseor is set then no accessor is exported into the
+If no accesseor is set then no accessor is exported into the
namespace of the caller.
Example:
@@ -1017,7 +1032,7 @@
use Log::Handler::Pattern;
use base qw(Log::Handler::Levels);
-our $VERSION = '0.51';
+our $VERSION = '0.52';
our $ERRSTR = '';
# $TRACE and $CALLER_LEVEL are both used as global
@@ -1249,6 +1264,67 @@
# $self->{pattern}->{'%X'}->{code} = 'value-of-x';
$self->{pattern}->{$pattern}->{name} = $name;
$self->{pattern}->{$pattern}->{code} = $code;
+}
+
+sub set_level {
+ @_ == 3 or Carp::croak 'Usage: $log->set_level( $alias => { minlevel => $min, maxlevel => $max } )';
+ my ($self, $name, $new) = @_;
+ my $alias = $self->{alias};
+
+ if (!exists $alias->{$name}) {
+ Carp::croak "alias '$name' does not exists";
+ }
+
+ if (ref($new) ne 'HASH') {
+ Carp::croak "the second parameter to set_level() must be a hash reference";
+ }
+
+ if (!defined $new->{minlevel} && !defined $new->{maxlevel}) {
+ Carp::croak "no new level given to set_level()";
+ }
+
+ foreach my $level (qw/minlevel maxlevel/) {
+ next unless defined $new->{$level};
+
+ if ($new->{$level} =~ LEVEL_RX) {
+ $alias->{$name}->{$level} = $new->{$level};
+ next if $new->{$level} =~ /^\d\z/;
+ $new->{$level} = uc($new->{$level});
+ $new->{$level} = $LEVEL_BY_STRING{ $new->{$level} };
+ $alias->{$name}->{$level} = $new->{$level};
+ } else {
+ Carp::croak "invalid level set to set_level()";
+ }
+ }
+
+ $alias->{$name}->{levels} = { };
+ my $levels = $self->{levels} = { };
+
+ foreach my $level_num ($alias->{$name}->{minlevel} .. $alias->{$name}->{maxlevel}) {
+ my $level = $LEVEL_BY_NUM[ $level_num ];
+ $alias->{$name}->{levels}->{$level} = 1;
+
+ if ($level_num < 4) {
+ $alias->{$name}->{levels}->{FATAL} = 1;
+ }
+ }
+
+ foreach my $output (@{ $self->{outputs} }) {
+ foreach my $level (keys %{$output->{levels}}) {
+ if ($levels->{$level}) {
+ my @old_order = @{$levels->{$level}};
+ $levels->{$level} = [
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, $_->{priority} ] } @old_order
+ ];
+ } else {
+ push @{$levels->{$level}}, $output;
+ }
+ }
+ }
+
+ return 1;
}
sub output {
@@ -1378,7 +1454,7 @@
sub _validate_options {
my ($self, @args) = @_;
- my (%wanted, $is_fatal);
+ my %wanted = ();
my $pattern = $self->{pattern};
# Option 'filter' is deprecated.
@@ -1490,7 +1566,7 @@
foreach my $level_num ($options{minlevel} .. $options{maxlevel}) {
my $level = $LEVEL_BY_NUM[ $level_num ];
$options{levels}{$level} = 1;
- next if $is_fatal || $level_num > 3;
+ next if $level_num > 3;
$options{levels}{FATAL} = 1;
}
Added: 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=36346&op=file
==============================================================================
--- branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t (added)
+++ branches/upstream/liblog-handler-perl/current/t/019-handler-setlevel.t Sun May 24 23:07:22 2009
@@ -1,0 +1,36 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Log::Handler;
+
+my $MESSAGE;
+
+sub test {
+ $MESSAGE++;
+}
+
+ok(1, 'use');
+
+my $log = Log::Handler->new();
+
+$log->add(
+ forward => {
+ alias => 'forward1',
+ forward_to => \&test,
+ minlevel => 'emerg',
+ maxlevel => 'error',
+ }
+);
+
+$log->error();
+
+$log->set_level(
+ forward1 => {
+ minlevel => 'emerg',
+ maxlevel => 'alert',
+ }
+);
+
+$log->error();
+
+ok($MESSAGE == 1, "check set_level($MESSAGE)");
More information about the Pkg-perl-cvs-commits
mailing list