# BEGIN BPS TAGGED BLOCK {{{
# COPYRIGHT:
# 
# This software is Copyright (c) 2003-2006 Best Practical Solutions, LLC
#                                          <clkao@bestpractical.com>
# 
# (Except where explicitly superseded by other copyright notices)
# 
# 
# LICENSE:
# 
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of either:
# 
#   a) Version 2 of the GNU General Public License.  You should have
#      received a copy of the GNU General Public License along with this
#      program.  If not, write to the Free Software Foundation, Inc., 51
#      Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
#      their web page on the internet at
#      http://www.gnu.org/copyleft/gpl.html.
# 
#   b) Version 1 of Perl's "Artistic License".  You should have received
#      a copy of the Artistic License with this package, in the file
#      named "ARTISTIC".  The license is also available at
#      http://opensource.org/licenses/artistic-license.php.
# 
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# CONTRIBUTION SUBMISSION POLICY:
# 
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of the
# GNU General Public License and is only of importance to you if you
# choose to contribute your changes and enhancements to the community
# by submitting them to Best Practical Solutions, LLC.)
# 
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with SVK,
# to Best Practical Solutions, LLC, you confirm that you are the
# copyright holder for those contributions and you grant Best Practical
# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
# perpetual, license to use, copy, create derivative works based on
# those contributions, and sublicense and distribute those contributions
# and any derivatives thereof.
# 
# END BPS TAGGED BLOCK }}}
package SVK::Logger;
use strict;
use warnings;

use SVK::Version;  our $VERSION = $SVK::VERSION;

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 $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' };
}

sub import {
  my $class = shift;
  my $var = shift || 'logger';
  
  # it's ok if people add a sigil; we can get rid of that.
  $var =~ s/^\$*//;
  
  # Find out which package we'll export into.
  my $caller = caller() . '';

  (my $name = $caller) =~ s/::/./g;
  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 
    # the exported variable name. Hope it isn't too bad form...
    no strict 'refs';
    *{ $caller . "::$var" } = \$logger;
  }
}

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 {
    $_[1] .= "\n" unless substr( $_[1], -1, 1 ) eq "\n";
    print $_[1];
};
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__

=head1 NAME

SVK::Logger - logging framework for SVK

=head1 SYNOPSIS

  use SVK::Logger;
  
  $logger->warn('foo');
  $logger->info('bar');
  
or 

  use SVK::Logger '$foo';
  
  $foo->error('bad thingimajig');

=head2 DESCRIPTION

SVK::Logger is a wrapper around Log::Log4perl. When using the module, it
imports into your namespace a variable called $logger (or you can pass a
variable name to import to decide what the variable should be) with a
category based on the name of the calling module.

=head1 MOTIVATION

Ideally, for support requests, if something is not going the way it
should be we should be able to tell people: "rerun the command with the
SVKLOGLEVEL environment variable set to DEBUG and mail the output to
$SUPPORTADDRESS". On Unix, this could be accomplished in one command like so:

  env SVKLOGLEVEL=DEBUG svk <command that failed> 2>&1 | mail $SUPPORTADDRESS