[Catalyst-commits] r8809 - in Catalyst-Runtime/5.80/trunk: . lib t

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2008-12-10 00:32:51 +0000 (Wed, 10 Dec 2008)
New Revision: 8809

Added:
   Catalyst-Runtime/5.80/trunk/t/unit_core_setup.t
Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
Log:
Patch to logging to add doc and make it possible to select levels and for them to be additive, from the dev list 3 months ago which I dropped on the floor..

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2008-12-09 23:36:52 UTC (rev 8808)
+++ Catalyst-Runtime/5.80/trunk/Changes	2008-12-10 00:32:51 UTC (rev 8809)
@@ -1,5 +1,8 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+        - Make log levels additive, and add documentation and tests
+          for the setup_log method, which previously had none.
+          Sewn together by t0m from two patches provided by David E. Wheeler
         - Switch an around 'new' in Catalyst::Controller to a BUILDARGS
           method as it's much neater and more obvious what is going on (t0m)
         - Add a clearer method on request and response _context 

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-09 23:36:52 UTC (rev 8808)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-10 00:32:51 UTC (rev 8809)
@@ -262,7 +262,9 @@
 
 =head2 -Log
 
-Specifies log level.
+    use Catalyst '-Log=warn,fatal,error';
+ 
+Specifies a comma-delimited list of log levels.
 
 =head2 -Stats
 
@@ -2204,19 +2206,34 @@
 
 =head2 $c->setup_log
 
-Sets up log.
+Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
+passing it to C<log()>. Pass in a comma-delimited list of levels to set the
+log to.
+ 
+This method also installs a C<debug> method that returns a true value into the
+catalyst subclass if the "debug" level is passed in the comma-delimited list,
+or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
 
+Note that if the log has already been setup, by either a previous call to
+C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
+that this method won't actually set up the log.
+
 =cut
 
 sub setup_log {
-    my ( $class, $debug ) = @_;
+    my ( $class, $levels ) = @_;
 
+    my %levels;
     unless ( $class->log ) {
-        $class->log( Catalyst::Log->new );
+        $levels ||= '';
+        $levels =~ s/^\s+//;
+        $levels =~ s/\s+$//;
+        %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
+        $class->log( Catalyst::Log->new(keys %levels) );
     }
 
     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
-    if ( defined($env_debug) ? $env_debug : $debug ) {
+    if ( defined($env_debug) or $levels{debug} ) {
         $class->Class::MOP::Object::meta()->add_method('debug' => sub { 1 });
         $class->log->debug('Debug messages enabled');
     }
@@ -2492,6 +2509,8 @@
 
 chicks: Christopher Hicks
 
+David E. Wheeler
+
 dkubb: Dan Kubb <dan.kubb-cpan at onautopilot.com>
 
 Drew Taylor

Added: Catalyst-Runtime/5.80/trunk/t/unit_core_setup.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_core_setup.t	                        (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/unit_core_setup.t	2008-12-10 00:32:51 UTC (rev 8809)
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+use Catalyst::Runtime;
+
+use Test::More tests => 18;
+
+{
+    # Silence the log.
+    no warnings 'redefine';
+    *Catalyst::Log::_send_to_log = sub {};
+}
+
+TESTDEBUG: {
+    package MyTestDebug;
+    use parent qw/Catalyst/;
+    __PACKAGE__->setup(
+        '-Debug',
+    );
+}
+
+ok my $c = MyTestDebug->new, 'Get debug app object';
+ok my $log = $c->log, 'Get log object';
+isa_ok $log,        'Catalyst::Log', 'It should be a Catalyst::Log object';
+ok !$log->is_warn,  'Warnings should be disabled';
+ok !$log->is_error, 'Errors should be disabled';
+ok !$log->is_fatal, 'Fatal errors should be disabled';
+ok !$log->is_info,  'Info should be disabled';
+ok $log->is_debug,  'Debugging should be enabled';
+can_ok 'MyTestDebug', 'debug';
+ok +MyTestDebug->debug, 'And it should return true';
+
+
+TESTAPP: {
+    package MyTestLog;
+    use parent qw/Catalyst/;
+    __PACKAGE__->setup(
+        '-Log=warn,error,fatal'
+    );
+}
+
+ok $c = MyTestLog->new, 'Get log app object';
+ok $log = $c->log, 'Get log object';
+isa_ok $log,        'Catalyst::Log', 'It should be a Catalyst::Log object';
+ok $log->is_warn,   'Warnings should be enabled';
+ok $log->is_error,  'Errors should be enabled';
+ok $log->is_fatal,  'Fatal errors should be enabled';
+ok !$log->is_info,  'Info should be disabled';
+ok !$log->is_debug, 'Debugging should be disabled';