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