r54233 - in /trunk/liblog-dispatchouli-perl: Changes MANIFEST META.json META.yml Makefile.PL README debian/changelog lib/Log/Dispatchouli.pm lib/Log/Dispatchouli/ t/basic.t t/proxy.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Mar 13 19:46:40 UTC 2010
Author: jawnsy-guest
Date: Sat Mar 13 19:46:34 2010
New Revision: 54233
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54233
Log:
New upstream release
Added:
trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli/
- copied from r54227, branches/upstream/liblog-dispatchouli-perl/current/lib/Log/Dispatchouli/
trunk/liblog-dispatchouli-perl/t/proxy.t
- copied unchanged from r54227, branches/upstream/liblog-dispatchouli-perl/current/t/proxy.t
Modified:
trunk/liblog-dispatchouli-perl/Changes
trunk/liblog-dispatchouli-perl/MANIFEST
trunk/liblog-dispatchouli-perl/META.json
trunk/liblog-dispatchouli-perl/META.yml
trunk/liblog-dispatchouli-perl/Makefile.PL
trunk/liblog-dispatchouli-perl/README
trunk/liblog-dispatchouli-perl/debian/changelog
trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm
trunk/liblog-dispatchouli-perl/t/basic.t
Modified: trunk/liblog-dispatchouli-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/Changes?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/Changes (original)
+++ trunk/liblog-dispatchouli-perl/Changes Sat Mar 13 19:46:34 2010
@@ -1,4 +1,14 @@
Revision history for Log-Dispatchouli
+
+1.100712 2010-03-12 21:43:13 America/New_York
+ add the quiet_fatal argument to suppress apparent double-logging to
+ standard output and error streams
+
+1.100711 2010-03-12 18:11:41 America/New_York
+
+1.100710 2010-03-12 09:51:32 America/New_York
+ add the Log::Dispatchouli::Proxy system
+ get_prefix now always returns a scalar (undef, not ())
1.100691 2010-03-10 17:10:53 America/New_York
just like 1.100690, but passes its own tests!
Modified: trunk/liblog-dispatchouli-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/MANIFEST?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/MANIFEST (original)
+++ trunk/liblog-dispatchouli-perl/MANIFEST Sat Mar 13 19:46:34 2010
@@ -7,6 +7,8 @@
README
dist.ini
lib/Log/Dispatchouli.pm
+lib/Log/Dispatchouli/Proxy.pm
t/basic.t
+t/proxy.t
t/release-pod-coverage.t
t/release-pod-syntax.t
Modified: trunk/liblog-dispatchouli-perl/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/META.json?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/META.json (original)
+++ trunk/liblog-dispatchouli-perl/META.json Sat Mar 13 19:46:34 2010
@@ -6,8 +6,8 @@
"version" : 1.4,
"url" : "http://module-build.sourceforge.net/META-spec-v1.4.html"
},
- "generated_by" : "Dist::Zilla version 1.100680",
- "version" : "1.100691",
+ "generated_by" : "Dist::Zilla version 1.100710",
+ "version" : "1.100712",
"name" : "Log-Dispatchouli",
"author" : [
"Ricardo SIGNES <rjbs at cpan.org>"
Modified: trunk/liblog-dispatchouli-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/META.yml?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/META.yml (original)
+++ trunk/liblog-dispatchouli-perl/META.yml Sat Mar 13 19:46:34 2010
@@ -5,7 +5,7 @@
build_requires: {}
configure_requires:
ExtUtils::MakeMaker: 6.11
-generated_by: 'Dist::Zilla version 1.100680'
+generated_by: 'Dist::Zilla version 1.100710'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -28,4 +28,4 @@
overload: 0
resources:
repository: git://git.codesimply.com/Log-Dispatchouli.git
-version: 1.100691
+version: 1.100712
Modified: trunk/liblog-dispatchouli-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/Makefile.PL?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/Makefile.PL (original)
+++ trunk/liblog-dispatchouli-perl/Makefile.PL Sat Mar 13 19:46:34 2010
@@ -21,7 +21,7 @@
'BUILD_REQUIRES' => {},
'ABSTRACT' => 'a simple wrapper around Log::Dispatch',
'EXE_FILES' => [],
- 'VERSION' => '1.100691',
+ 'VERSION' => '1.100712',
'PREREQ_PM' => {
'Try::Tiny' => '0.04',
'Scalar::Util' => '0',
Modified: trunk/liblog-dispatchouli-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/README?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/README (original)
+++ trunk/liblog-dispatchouli-perl/README Sat Mar 13 19:46:34 2010
@@ -1,7 +1,7 @@
This archive contains the distribution Log-Dispatchouli, version
-1.100691:
+1.100712:
a simple wrapper around Log::Dispatch
Modified: trunk/liblog-dispatchouli-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/debian/changelog?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/debian/changelog (original)
+++ trunk/liblog-dispatchouli-perl/debian/changelog Sat Mar 13 19:46:34 2010
@@ -1,3 +1,9 @@
+liblog-dispatchouli-perl (1.100712-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 13 Mar 2010 15:07:52 -0500
+
liblog-dispatchouli-perl (1.100691-1) unstable; urgency=low
* New upstream release
Modified: trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm (original)
+++ trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm Sat Mar 13 19:46:34 2010
@@ -1,22 +1,32 @@
use strict;
use warnings;
package Log::Dispatchouli;
-our $VERSION = '1.100691';
+our $VERSION = '1.100712';
# ABSTRACT: a simple wrapper around Log::Dispatch
use Carp ();
use Log::Dispatch;
-use Params::Util qw(_ARRAYLIKE _HASHLIKE _CODELIKE);
+use Params::Util qw(_ARRAY0 _HASH0 _CODELIKE);
use Scalar::Util qw(blessed weaken);
use String::Flogger;
use Try::Tiny 0.04;
+our @CARP_NOT = qw(Log::Dispatchouli::Proxy);
+
sub new {
my ($class, $arg) = @_;
my $ident = $arg->{ident}
or Carp::croak "no ident specified when using $class";
+
+ my %quiet_fatal;
+ for ('quiet_fatal') {
+ %quiet_fatal = map {; $_ => 1 } grep { defined }
+ exists $arg->{$_}
+ ? _ARRAY0($arg->{$_}) ? @{ $arg->{$_} } : $arg->{$_}
+ : ('stderr');
+ };
my $pid_prefix = exists $arg->{log_pid} ? $arg->{log_pid} : 1;
@@ -95,7 +105,8 @@
name => "std$dest",
min_level => 'debug',
stderr => ($dest eq 'err' ? 1 : 0),
- callbacks => sub { my %arg = @_; "$arg{message}\n"; }
+ callbacks => sub { my %arg = @_; "$arg{message}\n"; },
+ ($quiet_fatal{"std$dest"} ? (max_level => 'info') : ()),
),
);
}
@@ -104,28 +115,12 @@
$self->{prefix} = $arg->{prefix};
$self->{debug} = exists $arg->{debug}
- ? $arg->{debug}
- : $ENV{DISPATCHOULI_DEBUG};
+ ? ($arg->{debug} ? 1 : 0)
+ : ($ENV{DISPATCHOULI_DEBUG} ? 1 : 0);
$self->{fail_fatal} = exists $arg->{fail_fatal} ? $arg->{fail_fatal} : 1;
return $self;
-}
-
-
-sub new_tester {
- my ($class, $arg) = @_;
- $arg ||= {};
-
- return $class->new({
- %$arg,
- ($arg->{ident} ? () : (ident => "$$:$0")),
- to_stderr => 0,
- to_stdout => 0,
- to_file => 0,
- to_self => 1,
- facility => undef,
- });
}
@@ -133,22 +128,22 @@
sub log {
my ($self, @rest) = @_;
- my $arg;
- $arg = _HASHLIKE($rest[0]) ? shift(@rest) : {}; # for future expansion
+ my $arg = _HASH0($rest[0]) ? shift(@rest) : {};
my $message;
try {
my @flogged = map {; String::Flogger->flog($_) } @rest;
$message = @flogged > 1 ? $self->_join(\@flogged) : $flogged[0];
- my $prefix = $arg->{prefix};
- $prefix = $self->get_prefix if ! defined $prefix;
-
- if (defined $prefix) {
- if (_CODELIKE( $prefix )) {
- $message = $prefix->($message);
+ my $prefix = _ARRAY0($arg->{prefix})
+ ? [ @{ $arg->{prefix} } ]
+ : [ $arg->{prefix} ];
+
+ for (reverse grep { defined } $self->get_prefix, @$prefix) {
+ if (_CODELIKE( $_ )) {
+ $message = $_->($message);
} else {
- $message =~ s/^/$prefix/gm;
+ $message =~ s/^/$_/gm;
}
}
@@ -161,26 +156,22 @@
die $_ if $self->{fail_fatal};
};
- die $message if $arg->{fatal};
+ Carp::croak $message if $arg->{fatal};
return;
}
-
-sub info { shift()->log(@_); }
sub log_fatal {
my ($self, @rest) = @_;
my $arg;
- $arg = _HASHLIKE($rest[0]) ? shift(@rest) : {}; # for future expansion
+ $arg = _HASH0($rest[0]) ? shift(@rest) : {}; # for future expansion
local $arg->{level} = defined $arg->{level} ? $arg->{level} : 'error';
local $arg->{fatal} = defined $arg->{fatal} ? $arg->{fatal} : 1;
$self->log($arg, @rest);
}
-sub fatal { shift()->log_fatal(@_); }
-
sub log_debug {
my ($self, @rest) = @_;
@@ -188,35 +179,44 @@
return unless $self->is_debug;
my $arg;
- $arg = _HASHLIKE($rest[0]) ? shift(@rest) : {}; # for future expansion
+ $arg = _HASH0($rest[0]) ? shift(@rest) : {}; # for future expansion
local $arg->{level} = defined $arg->{level} ? $arg->{level} : 'debug';
$self->log($arg, @rest);
}
-sub debug { shift()->log_debug(@_); }
-
sub set_debug {
- return($_[0]->{debug} = ! ! $_[1]);
-}
-
-
-sub is_debug { return $_[0]->{debug} }
-
-sub is_info { 1 }
-sub is_fatal { 1 }
-
-
-sub dispatcher { $_[0]->{dispatcher} }
-
-sub get_prefix {
- return $_[0]->{prefix} if defined $_[0]->{prefix};
- return;
-}
-
+ return($_[0]->{debug} = $_[1] ? 1 : 0);
+}
+
+
+sub get_debug { return $_[0]->{debug} }
+
+
+sub clear_debug { }
+
+
+sub get_prefix { return $_[0]->{prefix} }
sub set_prefix { $_[0]->{prefix} = $_[1] }
-sub unset_prefix { undef $_[0]->{prefix} }
+sub clear_prefix { $_[0]->unset_prefix }
+sub unset_prefix { undef $_[0]->{prefix} }
+
+
+sub new_tester {
+ my ($class, $arg) = @_;
+ $arg ||= {};
+
+ return $class->new({
+ ident => "$$:$0",
+ %$arg,
+ to_stderr => 0,
+ to_stdout => 0,
+ to_file => 0,
+ to_self => 1,
+ facility => undef,
+ });
+}
sub events {
@@ -234,6 +234,36 @@
@{ $_[0]->{events} } = ();
return;
}
+
+
+sub proxy {
+ my ($self, $arg) = @_;
+ $arg ||= {};
+
+ require Log::Dispatchouli::Proxy;
+ Log::Dispatchouli::Proxy->_new({
+ parent => $self,
+ logger => $self,
+ proxy_prefix => $arg->{proxy_prefix},
+ (exists $arg->{debug} ? (debug => ($arg->{debug} ? 1 : 0)) : ()),
+ });
+}
+
+
+sub parent { $_[0] }
+sub logger { $_[0] }
+
+
+sub dispatcher { $_[0]->{dispatcher} }
+
+
+sub is_debug { $_[0]->get_debug }
+sub is_info { 1 }
+sub is_fatal { 1 }
+
+sub info { shift()->log(@_); }
+sub fatal { shift()->log_fatal(@_); }
+sub debug { shift()->log_debug(@_); }
use overload
'&{}' => sub { my ($self) = @_; sub { $self->log(@_) } },
@@ -252,7 +282,7 @@
=head1 VERSION
-version 1.100691
+version 1.100712
=head1 SYNOPSIS
@@ -298,25 +328,23 @@
Valid arguments are:
- ident - the name of the thing logging (mandatory)
- to_self - log to the logger object for testing; default: false
- to_file - log to PROGRAM_NAME.YYYYMMDD in the log path; default: false
- to_stdout - log to STDOUT; default: false
- to_stderr - log to STDERR; default: false
- facility - to which syslog facility to send logs; default: none
- log_pid - if true, prefix all log entries with the pid; default: true
- fail_fatal - a boolean; if true, failure to log is fatal; default: true
- debug - a boolean; if true, log_debug method is not a no-op
- defaults to the truth of the DISPATCHOULI_DEBUG env var
+ ident - the name of the thing logging (mandatory)
+ to_self - log to the logger object for testing; default: false
+ to_file - log to PROGRAM_NAME.YYYYMMDD in the log path; default: false
+ to_stdout - log to STDOUT; default: false
+ to_stderr - log to STDERR; default: false
+ facility - to which syslog facility to send logs; default: none
+ log_pid - if true, prefix all log entries with the pid; default: true
+ fail_fatal - a boolean; if true, failure to log is fatal; default: true
+ debug - a boolean; if true, log_debug method is not a no-op
+ defaults to the truth of the DISPATCHOULI_DEBUG env var
+ quiet_fatal - 'stderr' or 'stdout' or an arrayref of zero, one, or both
+ fatal log messages will not be logged to these
+ (default: stderr)
The log path is either F</tmp> or the value of the F<DISPATCHOULI_PATH> env var.
If the F<DISPATCHOULI_NOSYSLOG> env var is true, we don't log to syslog.
-
-=head2 new_tester
-
-This returns a new logger that logs only C<to_self>. It's useful in testing.
-If no C<ident> arg is provided, one will be generated.
=head2 log
@@ -328,11 +356,9 @@
message is flogged individually, then joined with spaces.
If the first argument is a hashref, it will be used as extra arguments to
-logging. At present, all entries in the hashref are ignored.
-
-This method can also be called as C<info>, to match other popular logging
-interfaces. B<If you want to override this method, you must override C<log>
-and not C<info>>.
+logging. It may include a C<prefix> entry to preprocess the message by
+prepending a string (if the prefix is a string) or calling a subroutine to
+generate a new message (if the prefix is a coderef).
=head2 log_fatal
@@ -359,16 +385,94 @@
This sets the logger's debug property, which affects the behavior of
C<log_debug>.
-=head2 is_debug
-
-C<is_debug> also exists as a read-only accessor. Much less usefully,
-C<is_info> and C<is_fatal> exist, both of which always return true.
+=head2 get_debug
+
+This gets the logger's debug property, which affects the behavior of
+C<log_debug>.
+
+=head2 clear_debug
+
+This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
+objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
+
+=head2 get_prefix
+
+ my $prefix = $logger->get_prefix;
+
+This method returns the currently-set prefix for the logger, which may be a
+string or code reference or undef. See L<Logger Prefix|/LOGGER PREFIX>.
+
+=head2 set_prefix
+
+ $logger->set_prefix( $new_prefix );
+
+This method changes the prefix. See L<Logger Prefix|/LOGGER PREFIX>.
+
+=head2 clear_prefix
+
+This method clears any set logger prefix. (It can also be called as
+C<unset_prefix>, but this is deprecated. See L<Logger Prefix|/LOGGER PREFIX>.
=head2 dispatcher
This returns the underlying Log::Dispatch object. This is not the method
you're looking for. Move along.
+=head1 LOGGER PREFIX
+
+Log messages may be prepended with information to set context. This can be set
+at a logger level or per log item. The simplest example is:
+
+ my $logger = Log::Dispatchouli->new( ... );
+
+ $logger->set_prefix("Batch 123: ");
+
+ $logger->log("begun processing");
+
+ # ...
+
+ $logger->log("finished processing");
+
+The above will log something like:
+
+ Batch 123: begun processing
+ Batch 123: finished processing
+
+To pass a prefix per-message:
+
+ $logger->log({ prefix => 'Sub-Item 234: ', 'error!' })
+
+ # Logs: Batch 123: Sub-Item 234: error!
+
+If the prefix is a string, it is prepended to each line of the message. If it
+is a coderef, it is called and passed the message to be logged. The return
+value is logged instead.
+
+L<Proxy loggers|/METHODS FOR PROXY LOGGERS> also have their own prefix
+settings, which accumulate. So:
+
+ my $proxy = $logger->proxy({ proxy_prefix => 'Subsystem 12: ' });
+
+ $proxy->set_prefix('Page 9: ');
+
+ $proxy->log({ prefix => 'Paragraph 6: ' }, 'Done.');
+
+...will log...
+
+ Batch 123: Subsystem 12: Page 9: Paragraph 6: Done.
+
+=head1 METHODS FOR TESTING
+
+=head2 new_tester
+
+ my $logger = Log::Dispatchouli->new_tester( \%arg );
+
+This returns a new logger that logs only C<to_self>. It's useful in testing.
+If no C<ident> arg is provided, one will be generated. C<log_pid> is off by
+default, but can be overridden.
+
+C<\%arg> is optional.
+
=head2 events
This method returns the arrayref of events logged to an array in memory (in the
@@ -379,11 +483,82 @@
This method empties the current sequence of events logged into an array in
memory. If the logger is not logging C<to_self> this raises an exception.
+=head1 METHODS FOR PROXY LOGGERS
+
+=head2 proxy
+
+ my $proxy_logger = $logger->proxy( \%arg );
+
+This method returns a new proxy logger -- an instance of
+L<Log::Dispatchouli::Proxy> -- which will log through the given logger, but
+which may have some settings localized.
+
+C<%arg> is optional. It may contain the following entries:
+
+=over 4
+
+=item proxy_prefix
+
+This is a prefix that will be applied to anything the proxy logger logs, and
+cannot be changed.
+
+=item debug
+
+This can be set to true or false to change the proxy's "am I in debug mode?"
+setting. It can be changed or cleared later on the proxy.
+
+=back
+
+=head2 parent
+
+=head2 logger
+
+These methods return the logger itself. (They're more useful when called on
+proxy loggers.)
+
+=head1 METHODS FOR API COMPATIBILITY
+
+To provide compatibility with some other loggers, most specifically
+L<Log::Contextual>, the following methods are provided. You should not use
+these methods without a good reason, and you should never subclass them.
+Instead, subclass the methods they call.
+
+=over 4
+
+=item is_debug
+
+This method calls C<get_debug>.
+
+=item is_info
+
+=item is_fatal
+
+These methods return true.
+
+=item info
+
+=item fatal
+
+=item debug
+
+These methods redispatch to C<log>, C<log_fatal>, and C<log_debug>
+respectively.
+
+=back
+
=head1 SEE ALSO
+=over 4
+
+=item *
+
L<Log::Dispatch>
+=item *
+
L<String::Flogger>
+
+=back
=head1 AUTHOR
Modified: trunk/liblog-dispatchouli-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/t/basic.t?rev=54233&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/t/basic.t (original)
+++ trunk/liblog-dispatchouli-perl/t/basic.t Sat Mar 13 19:46:34 2010
@@ -96,11 +96,11 @@
$logger->set_prefix('xyzzy: ');
$logger->log('foo');
- $logger->unset_prefix;
+ $logger->clear_prefix;
$logger->log('bar');
is($logger->events->[1]{message}, 'xyzzy: foo', 'set a prefix');
- is($logger->events->[2]{message}, 'bar', 'unset prefix');
+ is($logger->events->[2]{message}, 'bar', 'clear prefix');
}
{
More information about the Pkg-perl-cvs-commits
mailing list