[Catalyst-commits] r10257 - in Catalyst-Runtime/5.80/branches/log_factory/lib: . Catalyst

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2009-05-23 21:05:13 +0000 (Sat, 23 May 2009)
New Revision: 10257

Modified:
   Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst.pm
   Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst/Log.pm
Log:
Refactor log setup somewhat to make it easier to hook a custom module into the process.

Modified: Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst/Log.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst/Log.pm	2009-05-23 21:03:17 UTC (rev 10256)
+++ Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst/Log.pm	2009-05-23 21:05:13 UTC (rev 10257)
@@ -43,16 +43,12 @@
     }
 }
 
-around new => sub {
-    my $orig = shift;
-    my $class = shift;
-    my $self = $class->$orig;
+sub BUILD {
+    my ($self, $args) = @_;
+    my @levels = keys %{ $args->{levels} || {} };
+    $self->levels(scalar(@levels) ? @levels : keys %LEVELS);
+}
 
-    $self->levels( scalar(@_) ? @_ : keys %LEVELS );
-
-    return $self;
-};
-
 sub levels {
     my ( $self, @levels ) = @_;
     $self->level(0);

Modified: Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst.pm	2009-05-23 21:03:17 UTC (rev 10256)
+++ Catalyst-Runtime/5.80/branches/log_factory/lib/Catalyst.pm	2009-05-23 21:05:13 UTC (rev 10257)
@@ -2402,25 +2402,47 @@
 
 =cut
 
-sub setup_log {
-    my ( $class, $levels ) = @_;
+sub _build_log_instance {
+    my ( $class, $log_class, @args ) = @_;
+    $log_class->new(@args);
+}
 
+sub _build_cli_log_config {
+    my ($class, $levels) = @_;
     $levels ||= '';
     $levels =~ s/^\s+//;
     $levels =~ s/\s+$//;
-    my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
+    return { levels => { map { $_ => 1 } split /\s*,\s*/, $levels } };
+}
 
+sub _munge_log_config {
+    my ($class, @config) = @_;
+    @config;
+}
+
+sub log_class { 'Catalyst::Log' }
+
+sub setup_log {
+    my ( $class, $cli_levels ) = @_;
+
+    my $log_config = Catalyst::Utils::merge_hashes(
+        $class->config->{'Log'} || {}, $class->_build_cli_log_config($cli_levels)
+    );
+    my $levels = $log_config->{levels};
+
     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
     if ( defined $env_debug ) {
-        $levels{debug} = 1 if $env_debug; # Ugly!
-        delete($levels{debug}) unless $env_debug;
+        $levels->{debug} = 1 if $env_debug; # Ugly!
+        delete($levels->{debug}) unless $env_debug;
     }
 
     unless ( $class->log ) {
-        $class->log( Catalyst::Log->new(keys %levels) );
+        $class->log( $class->_build_log_instance(
+            $class->log_class => $class->_munge_log_config(%$log_config)
+        ));
     }
 
-    if ( $levels{debug} ) {
+    if ( $levels->{debug} ) {
         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
         $class->log->debug('Debug messages enabled');
     }