Modified Catalyst::Log to make it a bit easier to control logging output.

Tests are included, but these are only the minimum necessary to test the
desired behavior.  I've updated the docs (and fixed a small POD error, too).

This patch also adds a dependency on Test::NoWarnings.

Basically, you do this:

package Catalyst::Log::Subclass;
our @ISA = 'Catalyst::Log';

sub _send_to_log {
my $self = shift;
# @_ contains the log messages. Do with them
# what you will
}

In your app, you should then be able to do this to get your new behavior:

$c->log( Catalyst::Log::Subclass->new );

diff --git a/Makefile.PL b/Makefile.PL
index bf7c59e..645143c 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,6 +25,7 @@ requires 'Scalar::Util';
 requires 'Template';
 requires 'Text::SimpleTable' => 0.03;
 requires 'Test::MockObject';
+requires 'Test::NoWarnings' => 0.082;
 requires 'Time::HiRes';
 requires 'Tree::Simple';
 requires 'Tree::Simple::Visitor::FindByPath';

diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm
index 809294e..de7a447 100644 (file)
--- a/lib/Catalyst/Log.pm
+++ b/lib/Catalyst/Log.pm
@@ -81,11 +81,16 @@ sub _flush {
         $self->abort(undef);
     }
     else {
-        print( STDERR $self->body );
+        $self->_send_to_log( $self->body );
     }
     $self->body(undef);
 }
 
+sub _send_to_log {
+    my $self = shift;
+    print STDERR @_;
+}
+
 1;
 
 __END__
@@ -112,10 +117,9 @@ See L<Catalyst>.
 
 =head1 DESCRIPTION
 
-This module provides the default, simple logging functionality for
-Catalyst.
-If you want something different set C<$c->log> in your application
-module, e.g.:
+This module provides the default, simple logging functionality for Catalyst.
+If you want something different set C<< $c->log >> in your application module,
+e.g.:
 
     $c->log( MyLogger->new );
 
@@ -198,6 +202,14 @@ to use Log4Perl or another logger, you should call it like this:
 
     $c->log->abort(1) if $c->log->can('abort');
 
+=head2 _send_to_log
+
+ $log->_send_to_log( @messages );
+
+This protected method is what actually sends the log information to STDERR.
+You may subclass this module and override this method to get finer control
+over the log output.
+
 =head1 SEE ALSO
 
 L<Catalyst>.

diff --git a/t/unit_core_log.t b/t/unit_core_log.t
new file mode 100644 (file)
index 0000000..ff7e8a4
--- /dev/null
+++ b/t/unit_core_log.t
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More tests => 24;
+use Test::NoWarnings;    # Adds an extra test.
+
+my $timestamp = '\[\w{3}\s\w{3}\s[ 123]\d\s\d{2}:\d{2}:\d{2}\s\d{4}\]';
+my $LOG;
+
+BEGIN {
+    chdir 't' if -d 't';
+    use lib '../lib';
+    $LOG = 'Catalyst::Log';
+    use_ok $LOG or die;
+}
+my @MESSAGES;
+{
+    no warnings 'redefine';
+    *Catalyst::Log::_send_to_log = sub {
+        my $self = shift;
+        push @MESSAGES, @_;
+    };
+}
+
+can_ok $LOG, 'new';
+ok my $log = $LOG->new, '... and creating a new log object should succeed';
+isa_ok $log, $LOG, '... and the object it returns';
+
+can_ok $log, 'is_info';
+ok $log->is_info, '... and the default behavior is to allow info messages';
+
+can_ok $log, 'info';
+ok $log->info('hello there!'),
+    '... passing it an info message should succeed';
+
+can_ok $log, "_flush";
+$log->_flush;
+ok @MESSAGES, '... and flushing the log should succeed';
+is scalar @MESSAGES, 1, '... with one log message';
+like $MESSAGES[0], qr/^$timestamp \[catalyst\] \[info\] hello there!$/,
+    '... which should match the format we expect';
+
+{
+
+    package Catalyst::Log::Subclass;
+    our @ISA = 'Catalyst::Log';
+
+    sub _send_to_log {
+        my $self = shift;
+        push @MESSAGES, '---';
+        push @MESSAGES, @_;
+    }
+}
+
+my $SUBCLASS = 'Catalyst::Log::Subclass';
+can_ok $SUBCLASS, 'new';
+ok $log = Catalyst::Log::Subclass->new,
+    '... and the log subclass constructor shoudl return a new object';
+isa_ok $log, $SUBCLASS, '... and the object it returns';
+isa_ok $log, $LOG,      '... and it also';
+
+can_ok $log, 'info';
+ok $log->info('hi there!'),
+    '... passing it an info message should succeed';
+
+can_ok $log, "_flush";
+@MESSAGES = (); # clear the message log
+$log->_flush;
+ok @MESSAGES, '... and flushing the log should succeed';
+is scalar @MESSAGES, 2, '... with two log messages';
+is $MESSAGES[0], '---', '... with the first one being our new data';
+like $MESSAGES[1], qr/^$timestamp \[catalyst\] \[info\] hi there!$/,
+    '... which should match the format we expect';
+