API change: autoflush (log) now on by default + unit tests + POD
Henry Van Styn [Tue, 13 May 2014 15:58:13 +0000 (11:58 -0400)]
The new autoflush feature of Catalyst::Log now defaults to true and is
left on. In order to access the old behavior, modules such as
Static::Simple must manually turn it off (i.e. by hooking
setup_finalize, see example in POD).

Also updated logger unit tests, and added a new set of
autoflush-specific tests.

Note: this API change was suggested by mst

lib/Catalyst.pm
lib/Catalyst/Log.pm
t/aggregate/unit_core_log.t [changed mode: 0644->0755]
t/aggregate/unit_core_log_autoflush.t [new file with mode: 0755]

index f9cae7a..2732670 100755 (executable)
@@ -1250,13 +1250,8 @@ EOF
         $class->log->warn($class . "->config->{case_sensitive} is set.");
         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
     }
-
-    $class->setup_finalize;
     
-    # Turn autoflush back off once setup is finished.
-    # TODO: this is being done purely for Static::Simple (legacy API), and has been suggested by
-    # mst to be removed and require/update Static::Simple to set this flag itself
-    $class->log->autoflush(0) if ($class->log->can('autoflush'));
+    $class->setup_finalize;
 
     return $class || 1; # Just in case someone named their Application 0...
 }
@@ -2951,9 +2946,6 @@ sub setup_log {
         $class->log( Catalyst::Log->new(keys %levels) );
     }
     
-    # Turn on autoflush by default:
-    $class->log->autoflush(1) if ($class->log->can('autoflush'));
-
     if ( $levels{debug} ) {
         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
         $class->log->debug('Debug messages enabled');
@@ -3958,6 +3950,8 @@ t0m: Tomas Doran <bobtfish@bobtfish.net>
 
 Ulf Edvinsson
 
+vanstyn: Henry Van Styn <vanstyn@cpan.org>
+
 Viljo Marrandi C<vilts@yahoo.com>
 
 Will Hawes C<info@whawes.co.uk>
index 2418302..ee9a7e5 100755 (executable)
@@ -13,7 +13,7 @@ our %LEVEL_MATCH = (); # Stored as additive, thus debug = 31, warn = 30 etc
 has level => (is => 'rw');
 has _body => (is => 'rw');
 has abort => (is => 'rw');
-has autoflush => (is => 'rw');
+has autoflush => (is => 'rw', default => sub {1});
 has _psgi_logger => (is => 'rw', predicate => '_has_psgi_logger', clearer => '_clear_psgi_logger');
 has _psgi_errors => (is => 'rw', predicate => '_has_psgi_errors', clearer => '_clear_psgi_errors');
 
@@ -292,11 +292,25 @@ to use Log4Perl or another logger, you should call it like this:
 
 =head2 autoflush
 
-When enabled, messages are written to the log immediately instead of queued
-until the end of the request. By default, autoflush is enabled during setup,
-but turned back off thereafter. This is done purely for legacy support,
-specifically for L<Catalyst::Plugin::Static::Simple>, and may be changed in
-the future.
+When enabled (default), messages are written to the log immediately instead 
+of queued until the end of the request. 
+
+This option, as well as C<abort>, is provided for modules such as 
+L<Catalyst::Plugin::Static::Simple> to be able to programmatically 
+suppress the output of log messages. By turning off C<autoflush> (application-wide
+setting) and then setting the C<abort> flag within a given request, all log 
+messages for the given request will be suppressed. C<abort> can still be set
+independently of turning off C<autoflush>, however. It just means any messages 
+sent to the log up until that point in the request will obviously still be emitted, 
+since C<autoflush> means they are written in real-time.
+
+If you need to turn off autoflush you should do it like this (in your main app 
+class):
+
+    after setup_finalize => sub {
+      my $c = shift;
+      $c->log->autoflush(0) if $c->log->can('autoflush');
+    };
 
 =head2 _send_to_log
 
old mode 100644 (file)
new mode 100755 (executable)
index f488d48..9d50038
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 22;
+use Test::More tests => 24;
 
 use Catalyst::Log;
 
@@ -21,6 +21,9 @@ 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, "autoflush";
+$log->autoflush(0);
+
 can_ok $log, 'is_info';
 ok $log->is_info, '... and the default behavior is to allow info messages';
 
@@ -50,10 +53,13 @@ like $MESSAGES[0], qr/^\[info\] hello there!$/,
 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';
+    '... and the log subclass constructor should return a new object';
 isa_ok $log, $SUBCLASS, '... and the object it returns';
 isa_ok $log, $LOG,      '... and it also';
 
+can_ok $log, "autoflush";
+$log->autoflush(0);
+
 can_ok $log, 'info';
 ok $log->info('hi there!'),
     '... passing it an info message should succeed';
diff --git a/t/aggregate/unit_core_log_autoflush.t b/t/aggregate/unit_core_log_autoflush.t
new file mode 100755 (executable)
index 0000000..530d475
--- /dev/null
@@ -0,0 +1,66 @@
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+
+use Catalyst::Log;
+
+local *Catalyst::Log::_send_to_log;
+local our @MESSAGES;
+{
+    no warnings 'redefine';
+    *Catalyst::Log::_send_to_log = sub {
+        my $self = shift;
+        push @MESSAGES, @_;
+    };
+}
+
+my $LOG = 'Catalyst::Log';
+
+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';
+
+ok @MESSAGES, '... and immediately flush the log';
+is scalar @MESSAGES, 1, '... with one log message';
+like $MESSAGES[0], qr/^\[info\] hello there!$/,
+    '... which should match the format we expect';
+
+{
+
+    package Catalyst::Log::Subclass;
+    use base qw/Catalyst::Log/;
+
+    sub _send_to_log {
+        my $self = shift;
+        push @MESSAGES, '---';
+        push @MESSAGES, @_;
+    }
+}
+
+@MESSAGES = (); # clear the message log
+
+my $SUBCLASS = 'Catalyst::Log::Subclass';
+can_ok $SUBCLASS, 'new';
+ok $log = Catalyst::Log::Subclass->new,
+    '... and the log subclass constructor should 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';
+
+ok @MESSAGES, '... and immediately flush the log';
+is scalar @MESSAGES, 2, '... with two log messages';
+is $MESSAGES[0], '---', '... with the first one being our new data';
+like $MESSAGES[1], qr/^\[info\] hi there!$/,
+    '... which should match the format we expect';
+