lib/Log/Minimal.pm - metacpan.org

package Log::Minimal;

use strict;
use warnings;
use Term::ANSIColor qw//;

our $VERSION = '0.14';
our @EXPORT = map { ($_.'f', $_.'ff') } qw/crit warn info debug croak/;
push @EXPORT, 'ddf';

our $PRINT = sub {
    my ( $time, $type, $message, $trace, $raw_message) = @_;
    warn "$time [$type] $message at $trace\n";
};

our $DIE = sub {
    my ( $time, $type, $message, $trace, $raw_message) = @_;
    die "$time [$type] $message at $trace\n";
};

our $DEFAULT_COLOR = {
    info  => { text => 'green', },
    debug => {
        text       => 'red',
        background => 'white',
    },
    'warn' => {
        text       => 'black',
        background => 'yellow',
    },
    'critical' => {
        text       => 'black',
        background => 'red'
    },
    'error' => {
        text       => 'red',
        background => 'black'
    }
};

if ($ENV{LM_DEFAULT_COLOR}) {
    # LEVEL=FG;BG:LEVEL=FG;BG:...
    for my $level_color (split /:/, $ENV{LM_DEFAULT_COLOR}) {
        my($level, $color) = split /=/, $level_color, 2;
        my($fg, $bg)       = split /;/, $color, 2;
        $Log::Minimal::DEFAULT_COLOR->{$level} = {
            $fg ? (text       => $fg) : (),
            $bg ? (background => $bg) : (),
        };
    }
}

our $ENV_DEBUG = "LM_DEBUG";
our $AUTODUMP = 0;
our $LOG_LEVEL = 'DEBUG';
our $TRACE_LEVEL = 0;
our $COLOR = $ENV{LM_COLOR} || 0;

my %log_level_map = (
    DEBUG    => 1,
    INFO     => 2,
    WARN     => 3,
    CRITICAL => 4,
    MUTE     => 0,
    ERROR    => 99,
);

sub import {
    my $class   = shift;
    my $package = caller(0);
    my @args = @_;

    my %want_export;
    my $env_debug;
    while ( my $arg = shift @args ) {
        if ( $arg eq 'env_debug' ) {
            $env_debug = shift @args;
        }
        else {
            $want_export{$arg} = 1;
        }
    }

    if ( ! keys %want_export ) {
        #all
        $want_export{$_} = 1 for @EXPORT;
    }

    no strict 'refs';
    for my $f (grep !/^debug/, @EXPORT) {
        if ( $want_export{$f} ) {
            *{"$package\::$f"} = \&$f;
        }
    }

    for my $f (map { ($_.'f', $_.'ff') } qw/debug/) {
        if ( $want_export{$f} ) {
            if ( $env_debug ) {
                *{"$package\::$f"} = sub {
                    local $TRACE_LEVEL = $TRACE_LEVEL + 1;
                    local $ENV_DEBUG   = $env_debug;
                    $f->(@_);
                };
            }
            else {
                *{"$package\::$f"} = \&$f;
            }
        }
    }

}

sub critf {
    _log( "CRITICAL", 0, @_ );
}

sub warnf {
    _log( "WARN", 0, @_ );
}

sub infof {
    _log( "INFO", 0, @_ );
}

sub debugf {
    return if !$ENV{$ENV_DEBUG} || $log_level_map{DEBUG} < $log_level_map{uc $LOG_LEVEL};
    _log( "DEBUG", 0, @_ );
}

sub critff {
    _log( "CRITICAL", 1, @_ );
}

sub warnff {
    _log( "WARN", 1, @_ );
}

sub infoff {
    _log( "INFO", 1, @_ );
}

sub debugff {
    return if !$ENV{$ENV_DEBUG} || $log_level_map{DEBUG} < $log_level_map{uc $LOG_LEVEL};
    _log( "DEBUG", 1, @_ );
}

sub croakf {
    local $PRINT = $DIE;
    _log( "ERROR", 0, @_ );
}

sub croakff {
    local $PRINT = $DIE;
    _log( "ERROR", 1, @_ );
}

sub _log {
    my $tag = shift;
    my $full = shift;

    my $_log_level = $log_level_map{uc $LOG_LEVEL} || return;
    return unless $log_level_map{$tag} >= $_log_level;

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime(time);
    my $time    = sprintf(
        "%04d-%02d-%02dT%02d:%02d:%02d",
        $year + 1900,
        $mon + 1, $mday, $hour, $min, $sec
    );

    my $trace;
    if ( $full ) {
        my $i=$TRACE_LEVEL+1;
        my @stack;
        while ( my @caller = caller($i) ) {
            push @stack, "$caller[1] line $caller[2]";
            $i++;
        }
        $trace = join " ,", @stack
    }
    else {
        my @caller = caller($TRACE_LEVEL+1);
        $trace = "$caller[1] line $caller[2]";
    }

    my $messages = '';
    if ( @_ == 1 && defined $_[0]) {
        $messages = $AUTODUMP ? ''.Log::Minimal::Dumper->new($_[0]) : $_[0];
    }
    elsif ( @_ >= 2 )  {
        $messages = sprintf(shift, map { $AUTODUMP ? Log::Minimal::Dumper->new($_) : $_ } @_);
    }

    $messages =~ s/\x0d/\\r/g;
    $messages =~ s/\x0a/\\n/g;
    $messages =~ s/\x09/\\t/g;

    my $raw_message = $messages;
    if ( $COLOR ) {
        $messages = Term::ANSIColor::color($DEFAULT_COLOR->{lc($tag)}->{text}) 
            . $messages . Term::ANSIColor::color("reset")
                if $DEFAULT_COLOR->{lc($tag)}->{text};
        $messages = Term::ANSIColor::color("on_".$DEFAULT_COLOR->{lc($tag)}->{background}) 
            . $messages . Term::ANSIColor::color("reset")
                if $DEFAULT_COLOR->{lc($tag)}->{background};
    }

    $PRINT->(
        $time,
        $tag,
        $messages,
        $trace,
        $raw_message
    );
}

sub ddf {
    my $value = shift;
    Log::Minimal::Dumper::dumper($value);
}

1;

package
    Log::Minimal::Dumper;

use strict;
use warnings;
use base qw/Exporter/;
use Data::Dumper;
use Scalar::Util qw/blessed/;

use overload
    '""' => \&stringfy,
    '0+' => \&numeric,
    fallback => 1;

sub new {
    my ($class, $value) = @_;
    bless \$value, $class;
}

sub stringfy {
    my $self = shift;
    my $value = $$self;
    if ( blessed($value) && (my $stringify = overload::Method( $value, '""' ) || overload::Method( $value, '0+' )) ) {
        $value = $stringify->($value);
    }
    dumper($value);
}

sub numeric {
    my $self = shift;
    my $value = $$self;
    if ( blessed($value) && (my $numeric = overload::Method( $value, '0+' ) || overload::Method( $value, '""' )) ) {
        $value = $numeric->($value);
    }
    $value;
}

sub dumper {
    my $value = shift;
    if ( defined $value && ref($value) ) {
        local $Data::Dumper::Terse = 1;
        local $Data::Dumper::Indent = 0; 
        $value = Data::Dumper::Dumper($value);
    }
    $value;
}


1;
__END__

=head1 NAME

Log::Minimal - Minimal but customizable logger.

=head1 SYNOPSIS

  use Log::Minimal;

  critf("%s","foo"); # 2010-10-20T00:25:17 [CRITICAL] foo at example.pl line 12
  warnf("%d %s %s", 1, "foo", $uri);
  infof('foo');
  debugf("foo"); print if $ENV{LM_DEBUG} is true

  # with full stack trace
  critff("%s","foo");
  # 2010-10-20T00:25:17 [CRITICAL] foo at lib/Example.pm line 10, example.pl line 12
  warnff("%d %s %s", 1, "foo", $uri);
  infoff('foo');
  debugff("foo"); print if $ENV{LM_DEBUG} is true

  my $serialize = ddf({ 'key' => 'value' });

  # die with formatted message
  croakf('foo');
  croakff('%s %s', $code, $message);

=head1 DESCRIPTION

Log::Minimal is Minimal but customizable log module.

=head1 EXPORT FUNCTIONS

=over 4

=item critf(($message:Str|$format:Str,@list:Array));

  critf("could't connect to example.com");
  critf("Connection timeout timeout:%d, host:%s", 2, "example.com");

Display CRITICAL messages.
When two or more arguments are passed to the function, 
the first argument is treated as a format of printf. 

  local $Log::Minimal::AUTODUMP = 1;
  critf({ foo => 'bar' });
  critf("dump is %s", { foo => 'bar' });

If $Log::Minimal::AUTODUMP is true, reference or object message is serialized with 
Data::Dumper automatically.

=item warnf(($message:Str|$format:Str,@list:Array));

Display WARN messages.

=item infof(($message:Str|$format:Str,@list:Array));

Display INFO messages.

=item debugf(($message:Str|$format:Str,@list:Array));

Display DEBUG messages, if $ENV{LM_DEBUG} is true.

=item critff(($message:Str|$format:Str,@list:Array));

  critff("could't connect to example.com");
  critff("Connection timeout timeout:%d, host:%s", 2, "example.com");

Display CRITICAL messages with stack trace.

=item warnff(($message:Str|$format:Str,@list:Array));

Display WARN messages with stack trace.

=item infoff(($message:Str|$format:Str,@list:Array));

Display INFO messages with stack trace.

=item debugff(($message:Str|$format:Str,@list:Array));

Display DEBUG messages with stack trace, if $ENV{LM_DEBUG} is true.

=item croakf(($message:Str|$format:Str,@list:Array));

die with formatted $message

  croakf("critical error");
  # 2011-06-10T16:27:26 [ERROR] critical error at sample.pl line 23

=item croakff(($message:Str|$format:Str,@list:Array));

die with formatted $message with stack trace

=item ddf($value:Any)

Utility method that serializes given value with Data::Dumper;

 my $serialize = ddf($hashref);


=back

=head1 ENVIRONMENT VALUE

=over 4

=item $ENV{LM_DEBUG}

To print debugf and debugff messages, $ENV{LM_DEBUG} must be true.

You can change variable name from LM_DEBUG to arbitrary string which is specified by "env_debug" in use line. Changed variable name affects only in package locally.

  use Log::Minimal env_debug => 'FOO_DEBUG';
  
  $ENV{LM_DEBUG}  = 1;
  $ENV{FOO_DEBUG} = 0;
  debugf("hello"); # no output
  
  $ENV{FOO_DEBUG} = 1;
  debugf("world"); # print message

=item $ENV{LM_COLOR}

$ENV{LM_COLOR} is used as default value of $Log::Minimal::COLOR

=item $ENV{LM_DEFAULT_COLOR}

$ENV{LM_DEFAULT_COLOR} is used as default value of $Log::Minimal::DEFAULT_COLOR

Format of value is "LEVEL=FG;BG:LEVEL=FG;BG:...". "FG" and "BG" are optional.

For example:

  export LM_DEFAULT_COLOR='debug=red:info=;cyan:critical=yellow;red'

=back

=head1 CUSTOMIZE

=over 4

=item $Log::Minimal::COLOR

Coloring log messages. Disabled by default.

=item $Log::Minimal::PRINT

To change the method of outputting the log, set $Log::Minimal::PRINT.

  # with PSGI Application. output log with request uri.
  my $app = sub {
      my $env = shift;
      local $Log::Minimal::PRINT = sub {
          my ( $time, $type, $message, $trace,$raw_message) = @_;
          $env->{psgi.errors}->print(
              "$time [$env->{SCRIPT_NAME}] [$type] $message at $trace\n");
      };
      run_app(...);
  }

$message includes color sequences, If you want raw message text, use $raw_message.
default is

  sub {
    my ( $time, $type, $message, $trace,$raw_message) = @_;
    warn "$time [$type] $message at $trace\n";
  }

=item $Log::Minimal::DIE

To change the format of die message, set $Log::Minimal::DIE.

  local $Log::Minimal::PRINT = sub {
      my ( $time, $type, $message, $trace) = @_;
      die "[$type] $message at $trace\n"; # not need time
  };

default is

  sub {
    my ( $time, $type, $message, $trace) = @_;
    die "$time [$type] $message at $trace\n";
  }

=item $Log::Minimal::LOG_LEVEL

Set level to output log.

  local $Log::Minimal::LOG_LEVEL = "WARN";
  infof("foo"); #print nothing
  warnf("foo");

Support levels are DEBUG,INFO,WARN,CRITICAL and NONE.
If NONE is set, no output. Default log level is DEBUG.

=item $Log::Minimal::AUTODUMP

Serialize message with Data::Dumper.

  warnf("%s",{ foo => bar}); # HASH(0x100804ed0)

  local $Log::Minimal::AUTODUMP = 1;
  warnf("dump is %s", {foo=>'bar'}); #dump is {foo=>'bar'}

  my $uri = URI->new("http://search.cpan.org/");
  warnf("uri: '%s'", $uri); # uri: 'http://search.cpan.org/'

If message is object and has overload methods like '""' or '0+', 
Log::Minimal uses it instead of Data::Dumper.

=item $Log::Minimal::TRACE_LEVEL

Like a $Carp::CarpLevel, this variable determines how many additional call frames are to be skipped.
Defaults to 0.

=back

=head1 AUTHOR

Masahiro Nagano E<lt>kazeburo {at} gmail.comE<gt>

=head1 THANKS TO

Yuji Shimada (xaicron)

Yoshihiro Sugi (sugyan)

=head1 SEE ALSO

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)