[svk-commit] r2187 - in trunk: lib/SVK

[clkao at bestpractical.com]

Author: clkao
Date: Mon Nov 20 06:55:31 2006
New Revision: 2187

Modified:
   trunk/Makefile.PL
   trunk/lib/SVK/Command.pm
   trunk/lib/SVK/Logger.pm
   trunk/lib/SVK/Mirror.pm

Log:
Make log4perl an optional dependency.

Modified: trunk/Makefile.PL
==============================================================================
--- trunk/Makefile.PL	(original)
+++ trunk/Makefile.PL	Mon Nov 20 06:55:31 2006
@@ -27,7 +27,6 @@
     'Class::Autouse'           => '1.15',
     'App::CLI'                 => '0',
     'List::MoreUtils'          => '0',
-    'Log::Log4perl'            => '0',
     'Class::Accessor::Fast'    => '0',
     'Class::Data::Inheritable' => '0',
     'Path::Class'              => '0.15',
@@ -52,8 +51,13 @@
         -default => 1,
         'IO::Pager'             => '0',
     ],
+    'Log4perl support' => [
+        -default => 0,
+        'Log::Log4perl'         => '0',
+    ]
 );
 
+
 if( eval{ require SVN::Mirror } ) {
     requires( 'SVN::Mirror' => $required_svm );
 } else {

Modified: trunk/lib/SVK/Command.pm
==============================================================================
--- trunk/lib/SVK/Command.pm	(original)
+++ trunk/lib/SVK/Command.pm	Mon Nov 20 06:55:31 2006
@@ -364,7 +364,7 @@
     # this is going to take a while, release giant lock
     $self->{xd}->giant_unlock;
 
-    $logger->info(loc("New URI encountered: %1\n", $uri));
+    $logger->info(loc("New URI encountered: %1", $uri));
 
     my $depots = join('|', map quotemeta, sort keys %$map);
     my ($base_uri, $rel_uri);

Modified: trunk/lib/SVK/Logger.pm
==============================================================================
--- trunk/lib/SVK/Logger.pm	(original)
+++ trunk/lib/SVK/Logger.pm	Mon Nov 20 06:55:31 2006
@@ -4,23 +4,31 @@
 
 use SVK::Version;  our $VERSION = $SVK::VERSION;
 
-use Log::Log4perl qw(get_logger :levels);
+if (eval {
+        require Log::Log4perl;
+        Log::Log4perl->import(':levels');
+        1;
+    } ) {
+    my $level = { map { $_ => uc $_ } qw( debug info warn error fatal ) }
+        ->{ lc $ENV{SVKLOGLEVEL} } || 'INFO';
 
-my $level = {
-    map { $_ => uc $_ } qw( debug info warn error fatal )
-}->{ lc $ENV{SVKLOGLEVEL} } || 'INFO';
-
-my $conf = qq{
+    my $conf = qq{
   log4perl.rootLogger=$level, Screen
   log4perl.appender.Screen = Log::Log4perl::Appender::Screen
   log4perl.appender.Screen.stderr = 0
   log4perl.appender.Screen.layout = PatternLayout
   log4perl.appender.Screen.layout.ConversionPattern = %m%n
-};
+  };
+
+    # ... passed as a reference to init()
+    Log::Log4perl::init( \$conf );
+    *get_logger = sub { Log::Log4perl->get_logger(@_) };
+
+}
+else {
+    *get_logger = sub { 'SVK::Logger::Compat' };
+}
 
-# ... passed as a reference to init()
-Log::Log4perl::init( \$conf );
-    
 sub import {
   my $class = shift;
   my $var = shift || 'logger';
@@ -32,7 +40,7 @@
   my $caller = caller() . '';
 
   (my $name = $caller) =~ s/::/./g;
-  my $logger = Log::Log4perl->get_logger(lc($name));
+  my $logger = get_logger(lc($name));
   {
     # As long as we don't use a package variable, each module we export
     # into will get their own object. Also, this allows us to decide on 
@@ -42,6 +50,39 @@
   }
 }
 
+package SVK::Logger::Compat;
+require Carp;
+
+my $current_level;
+my $level;
+
+BEGIN {
+my $i;
+$level = { map { $_ => ++$i } reverse qw( debug info warn error fatal ) };
+$current_level = $level->{lc $ENV{SVKLOGLEVEL}} || $level->{info};
+
+my $ignore  = sub { return };
+my $warn    = sub { shift; $_[0] .= "\n"; print $_[0] };
+#my $die     = sub { shift; $_[0] .= "\n" unless ref($_[0]); goto \&CORE::GLOBAL::die };
+my $die     = sub { shift; die $_[0]."\n"; };
+my $carp    = sub { shift; goto \&Carp::carp };
+my $confess = sub { shift; goto \&Carp::confess };
+my $croak   = sub { shift; goto \&Carp::croak };
+
+*debug      = $current_level >= $level->{debug} ? $warn : $ignore;
+*info       = $current_level >= $level->{info}  ? $warn : $ignore;
+*warn       = $current_level >= $level->{warn}  ? $warn : $ignore;
+*error      = $current_level >= $level->{warn}  ? $warn : $ignore;
+*fatal      = $die;
+*logconfess = $confess;
+*logdie     = $die;
+*logcarp    = $carp;
+*logcroak   = $croak;
+
+}
+
+sub is_debug { $current_level >= $level->{debug} }
+
 1;
 
 __END__

Modified: trunk/lib/SVK/Mirror.pm
==============================================================================
--- trunk/lib/SVK/Mirror.pm	(original)
+++ trunk/lib/SVK/Mirror.pm	Mon Nov 20 06:55:31 2006
@@ -344,7 +344,6 @@
 This is essentially making a checkout of the url, and is bad if the
 url contains directories like trunk and branches.  If this isn't what
 you mean, please hit ^C.
-
 ", $self->url));
 
     $self->run_svnmirror_sync( { skip_to => $snapshot });