r54176 - in /trunk/liblog-dispatchouli-perl: Changes META.json META.yml Makefile.PL README debian/changelog debian/control debian/copyright lib/Log/Dispatchouli.pm t/basic.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Mar 12 12:34:01 UTC 2010
Author: jawnsy-guest
Date: Fri Mar 12 12:33:41 2010
New Revision: 54176
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54176
Log:
* New upstream release
* Add myself to Uploaders and Copyright
* Rewrite control description
Modified:
trunk/liblog-dispatchouli-perl/Changes
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/debian/control
trunk/liblog-dispatchouli-perl/debian/copyright
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=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/Changes (original)
+++ trunk/liblog-dispatchouli-perl/Changes Fri Mar 12 12:33:41 2010
@@ -1,4 +1,29 @@
Revision history for Log-Dispatchouli
+
+1.100691 2010-03-10 17:10:53 America/New_York
+ just like 1.100690, but passes its own tests!
+
+1.100690 2010-03-10 14:24:59 America/New_York
+ remove obsolete "list_name" alias to prefix
+ object-level prefix no longer automatically ends in ": "
+
+1.100681 2010-03-09 23:02:11 America/New_York
+ rerelease with a tarball that isn't totally insane
+
+1.100680 2010-03-09 22:47:23 America/New_York
+ rewrite all log_ methods in terms of ->log
+ ->log now includes the code formerly in the internal ->_log_at
+ add a new per-message prefix system
+ old-style prefix (to be removed) now handle multi-line messages
+
+ * new prefix system is not yet documented, pending experimentation
+
+1.100670 2010-03-08 19:15:30 America/New_York
+ make env vars in code match env vars in docs
+
+1.100660 2010-03-07 22:00:58 America/New_York
+ add clear_events method
+ loggers made with new_tester log to_self
1.100630 2010-03-04 18:41:13 America/New_York
some more docs
Modified: trunk/liblog-dispatchouli-perl/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/META.json?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/META.json (original)
+++ trunk/liblog-dispatchouli-perl/META.json Fri Mar 12 12:33:41 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.100630",
- "version" : "1.100630",
+ "generated_by" : "Dist::Zilla version 1.100680",
+ "version" : "1.100691",
"name" : "Log-Dispatchouli",
"author" : [
"Ricardo SIGNES <rjbs at cpan.org>"
@@ -16,19 +16,19 @@
"build_requires" : {},
"requires" : {
"Try::Tiny" : "0.04",
- "Scalar::Util" : 0,
- "Log::Dispatch::Array" : 0,
- "overload" : 0,
+ "Scalar::Util" : "0",
+ "Log::Dispatch::Array" : "0",
+ "overload" : "0",
"Sys::Syslog" : "0.16",
- "Carp" : 0,
+ "Carp" : "0",
"Test::More" : "0.88",
- "Log::Dispatch::File" : 0,
- "Params::Util" : 0,
- "Log::Dispatch::Screen" : 0,
- "Log::Dispatch" : 0,
- "Log::Dispatch::Syslog" : 0,
- "Test::Deep" : 0,
- "String::Flogger" : 0
+ "Log::Dispatch::File" : "0",
+ "Params::Util" : "0",
+ "Log::Dispatch::Screen" : "0",
+ "Log::Dispatch" : "0",
+ "Log::Dispatch::Syslog" : "0",
+ "Test::Deep" : "0",
+ "String::Flogger" : "0"
},
"abstract" : "a simple wrapper around Log::Dispatch",
"configure_requires" : {
Modified: trunk/liblog-dispatchouli-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/META.yml?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/META.yml (original)
+++ trunk/liblog-dispatchouli-perl/META.yml Fri Mar 12 12:33:41 2010
@@ -5,7 +5,7 @@
build_requires: {}
configure_requires:
ExtUtils::MakeMaker: 6.11
-generated_by: 'Dist::Zilla version 1.100630'
+generated_by: 'Dist::Zilla version 1.100680'
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.100630
+version: 1.100691
Modified: trunk/liblog-dispatchouli-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/Makefile.PL?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/Makefile.PL (original)
+++ trunk/liblog-dispatchouli-perl/Makefile.PL Fri Mar 12 12:33:41 2010
@@ -21,22 +21,22 @@
'BUILD_REQUIRES' => {},
'ABSTRACT' => 'a simple wrapper around Log::Dispatch',
'EXE_FILES' => [],
- 'VERSION' => '1.100630',
+ 'VERSION' => '1.100691',
'PREREQ_PM' => {
'Try::Tiny' => '0.04',
- 'Scalar::Util' => 0,
- 'Log::Dispatch::Array' => 0,
- 'overload' => 0,
+ 'Scalar::Util' => '0',
+ 'Log::Dispatch::Array' => '0',
+ 'overload' => '0',
'Sys::Syslog' => '0.16',
- 'Carp' => 0,
+ 'Carp' => '0',
'Test::More' => '0.88',
- 'Log::Dispatch::File' => 0,
- 'Params::Util' => 0,
- 'Log::Dispatch::Screen' => 0,
- 'Log::Dispatch' => 0,
- 'Log::Dispatch::Syslog' => 0,
- 'Test::Deep' => 0,
- 'String::Flogger' => 0
+ 'Log::Dispatch::File' => '0',
+ 'Params::Util' => '0',
+ 'Log::Dispatch::Screen' => '0',
+ 'Log::Dispatch' => '0',
+ 'Log::Dispatch::Syslog' => '0',
+ 'Test::Deep' => '0',
+ 'String::Flogger' => '0'
},
'LICENSE' => 'perl'
);
Modified: trunk/liblog-dispatchouli-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/README?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/README (original)
+++ trunk/liblog-dispatchouli-perl/README Fri Mar 12 12:33:41 2010
@@ -1,7 +1,7 @@
This archive contains the distribution Log-Dispatchouli, version
-1.100630:
+1.100691:
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=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/debian/changelog (original)
+++ trunk/liblog-dispatchouli-perl/debian/changelog Fri Mar 12 12:33:41 2010
@@ -1,3 +1,11 @@
+liblog-dispatchouli-perl (1.100691-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Add myself to Uploaders and Copyright
+ * Rewrite control description
+
+ -- Jonathan Yu <jawnsy at cpan.org> Fri, 12 Mar 2010 08:00:39 -0500
+
liblog-dispatchouli-perl (1.100630-1) unstable; urgency=low
* Initial release (closes: #572665).
Modified: trunk/liblog-dispatchouli-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/debian/control?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/debian/control (original)
+++ trunk/liblog-dispatchouli-perl/debian/control Fri Mar 12 12:33:41 2010
@@ -8,7 +8,7 @@
perl (>= 5.10.1) | libtest-simple-perl (>= 0.88),
perl (>= 5.10) | libsys-syslog-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: gregor herrmann <gregoa at debian.org>
+Uploaders: gregor herrmann <gregoa at debian.org>, Jonathan Yu <jawnsy at cpan.org>
Standards-Version: 3.8.4
Homepage: http://search.cpan.org/dist/Log-Dispatchouli/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/liblog-dispatchouli-perl/
@@ -21,19 +21,16 @@
liblog-dispatch-perl, libparams-util-perl, libtest-deep-perl,
libstring-flogger-perl, perl (>= 5.10) | libsys-syslog-perl
Description: simple wrapper around Log::Dispatch
- Log::Dispatchouli is a thin layer above Log::Dispatch and meant to make it
- dead simple to add logging to a program without having to think much about
- categories, facilities, levels, or things like that. It is meant to make
- logging just configurable enough that you can find the logs you want and just
- easy enough that you will actually log things.
+ Log::Dispatchouli is a simple wrapper around Log::Dispatch intended to make
+ it simpler to add logging to a program. It removes the need to think much
+ about categories, facilities, levels, or things like that. It makes logging
+ just configurable enough so you can find the logs you want, and easy enough
+ that you will actually log things.
.
Log::Dispatchouli can log to syslog (if you specify a facility), standard
- error or standard output, to a file, or to an array in memory. That last one
- is mostly useful for testing.
+ error or standard output, to a file, or to an array in memory. Logging to
+ memory is primarily intended for testing.
.
- In addition to providing as simple a way to get a handle for logging
- operations, Log::Dispatchouli uses String::Flogger to process the things to
- be logged, meaning you can easily log data structures. Basically: strings are
- logged as is, arrayrefs are taken as (sprintf format, args), and subroutines
- are called only if needed. For more information read the String::Flogger
- docs.
+ Additionally, Log::Dispatchouli uses String::Flogger to process the things to
+ be logged, meaning you can easily log data structures. For more information,
+ see String::Flogger (libstring-flogger-perl).
Modified: trunk/liblog-dispatchouli-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/debian/copyright?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/debian/copyright (original)
+++ trunk/liblog-dispatchouli-perl/debian/copyright Fri Mar 12 12:33:41 2010
@@ -9,6 +9,7 @@
Files: debian/*
Copyright: 2010, gregor herrmann <gregoa at debian.org>
+ 2010, Jonathan Yu <jawnsy at cpan.org>
License: Artistic or GPL-1+
License: Artistic
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=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm (original)
+++ trunk/liblog-dispatchouli-perl/lib/Log/Dispatchouli.pm Fri Mar 12 12:33:41 2010
@@ -1,12 +1,12 @@
use strict;
use warnings;
package Log::Dispatchouli;
-our $VERSION = '1.100630';
+our $VERSION = '1.100691';
# ABSTRACT: a simple wrapper around Log::Dispatch
use Carp ();
use Log::Dispatch;
-use Params::Util qw(_ARRAYLIKE _HASHLIKE);
+use Params::Util qw(_ARRAYLIKE _HASHLIKE _CODELIKE);
use Scalar::Util qw(blessed weaken);
use String::Flogger;
use Try::Tiny 0.04;
@@ -31,7 +31,7 @@
if ($arg->{to_file}) {
require Log::Dispatch::File;
my $log_file = File::Spec->catfile(
- ($ENV{LOG_DISPATCHOULI} || File::Spec->tempdir),
+ ($ENV{DISPATCHOULI_PATH} || File::Spec->tempdir),
sprintf('%s.%04u%02u%02u',
$ident,
((localtime)[5] + 1900),
@@ -55,7 +55,7 @@
);
}
- if ($arg->{facility} and not $ENV{LOG_DISPATCHOULI_NOSYSLOG}) {
+ if ($arg->{facility} and not $ENV{DISPATCHOULI_NOSYSLOG}) {
require Log::Dispatch::Syslog;
$log->add(
Log::Dispatch::Syslog->new(
@@ -101,7 +101,7 @@
}
$self->{dispatcher} = $log;
- $self->{prefix} = $arg->{prefix} || $arg->{list_name};
+ $self->{prefix} = $arg->{prefix};
$self->{debug} = exists $arg->{debug}
? $arg->{debug}
@@ -123,6 +123,7 @@
to_stderr => 0,
to_stdout => 0,
to_file => 0,
+ to_self => 1,
facility => undef,
});
}
@@ -130,21 +131,29 @@
sub _join { shift; join q{ }, @{ $_[0] } }
-sub _log_at {
- my ($self, $arg, @rest) = @_;
- shift @rest if _HASHLIKE($rest[0]); # for future expansion
-
- if (defined (my $prefix = $self->get_prefix)) {
- unshift @rest, "$prefix:";
- }
+sub log {
+ my ($self, @rest) = @_;
+ my $arg;
+ $arg = _HASHLIKE($rest[0]) ? shift(@rest) : {}; # for future expansion
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);
+ } else {
+ $message =~ s/^/$prefix/gm;
+ }
+ }
+
$self->dispatcher->log(
- level => $arg->{level},
+ level => $arg->{level} || 'info',
message => $message,
);
} catch {
@@ -157,17 +166,32 @@
return;
}
-sub log { shift()->_log_at({ level => 'info' }, @_); }
sub info { shift()->log(@_); }
-sub log_fatal { shift()->_log_at({ level => 'error', fatal => 1 }, @_); }
+sub log_fatal {
+ my ($self, @rest) = @_;
+ my $arg;
+ $arg = _HASHLIKE($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 {
- return unless $_[0]->is_debug;
- shift()->_log_at({ level => 'debug' }, @_);
+ my ($self, @rest) = @_;
+
+ return unless $self->is_debug;
+
+ my $arg;
+ $arg = _HASHLIKE($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(@_); }
@@ -200,6 +224,15 @@
unless $_[0]->{events};
return $_[0]->{events};
+}
+
+
+sub clear_events {
+ Carp::confess "->events called on a logger not logging to self"
+ unless $_[0]->{events};
+
+ @{ $_[0]->{events} } = ();
+ return;
}
use overload
@@ -219,7 +252,7 @@
=head1 VERSION
-version 1.100630
+version 1.100691
=head1 SYNOPSIS
@@ -282,8 +315,8 @@
=head2 new_tester
-This returns a new logger that doesn't log. It's useful in testing. If no
-C<ident> arg is provided, one will be generated.
+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
@@ -341,6 +374,11 @@
This method returns the arrayref of events logged to an array in memory (in the
logger). If the logger is not logging C<to_self> this raises an exception.
+=head2 clear_events
+
+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 SEE ALSO
L<Log::Dispatch>
Modified: trunk/liblog-dispatchouli-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-dispatchouli-perl/t/basic.t?rev=54176&op=diff
==============================================================================
--- trunk/liblog-dispatchouli-perl/t/basic.t (original)
+++ trunk/liblog-dispatchouli-perl/t/basic.t Fri Mar 12 12:33:41 2010
@@ -59,6 +59,33 @@
log_pid => 0,
});
+ $logger->log('foo');
+ cmp_deeply($logger->events, [ superhashof({ message =>'foo' }) ], 'log foo');
+
+ $logger->clear_events;
+ cmp_deeply($logger->events, [ ], 'log empty after clear');
+
+ $logger->log('bar');
+ cmp_deeply($logger->events, [ superhashof({ message =>'bar' }) ], 'log bar');
+
+ $logger->log('foo');
+ cmp_deeply(
+ $logger->events,
+ [
+ superhashof({ message =>'bar' }),
+ superhashof({ message =>'foo' }),
+ ],
+ 'log keeps accumulating',
+ );
+}
+
+{
+ my $logger = Log::Dispatchouli->new({
+ ident => 'foo',
+ to_self => 1,
+ log_pid => 0,
+ });
+
$logger->log([ '%s %s', '[foo]', [qw(foo)] ], "..");
is(
@@ -67,7 +94,7 @@
"multi-arg logging",
);
- $logger->set_prefix('xyzzy');
+ $logger->set_prefix('xyzzy: ');
$logger->log('foo');
$logger->unset_prefix;
$logger->log('bar');
@@ -81,4 +108,57 @@
like($@, qr/no ident specified/, "can't make a logger without ident");
}
+{
+ my $logger = Log::Dispatchouli->new({
+ ident => 'foo',
+ to_self => 1,
+ log_pid => 0,
+ });
+
+ $logger->log({ prefix => '[ALERT] ' }, "foo\nbar\nbaz");
+
+ my $want_0 = <<'END_LOG';
+[ALERT] foo
+[ALERT] bar
+[ALERT] baz
+END_LOG
+
+ chomp $want_0;
+
+ $logger->log(
+ {
+ prefix => sub {
+ my $m = shift;
+ my @lines = split /\n/, $m;
+ $lines[0] = "<<< $lines[0]";
+ $lines[1] = "||| $lines[1]";
+ $lines[2] = ">>> $lines[2]";
+
+ return join "\n", @lines;
+ },
+ },
+ "foo\nbar\nbaz",
+ );
+
+ my $want_1 = <<'END_LOG';
+<<< foo
+||| bar
+>>> baz
+END_LOG
+
+ chomp $want_1;
+
+ is(
+ $logger->events->[0]{message},
+ $want_0,
+ "multi-line and prefix (string)",
+ );
+
+ is(
+ $logger->events->[1]{message},
+ $want_1,
+ "multi-line and prefix (code)",
+ );
+}
+
done_testing;
More information about the Pkg-perl-cvs-commits
mailing list