end0tknr's kipple - web写経開発

太宰府天満宮の狛犬って、妙にカワイイ

logging by Log::Dispatch (Log::Dispatch::Config) for perl

http://search.cpan.org/perldoc?Log%3A%3ADispatch
http://search.cpan.org/perldoc?Log%3A%3ADispatch%3A%3AConfig

Log::Dispatch::Config のおかげで、Log::Dispatch がグッと使いやすくなります。
以下、sample code.

caller

#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use lib qw/lib/;
use LogTest;
use Data::Dumper;


my $LOGGER = LogTest->new();
$LOGGER->info(1);
$LOGGER->debug('test');
$LOGGER->info('これはテスト');
$LOGGER->info({key=>'これはテスト'});

wrapper of Log::Dispatch (Log::Dispatch::Config)

package LogTest;
use strict;
use utf8;
use Encode;
use Log::Dispatch::Config;
use base qw/Log::Dispatch::Configurator/;
use Data::Dumper;
$Log::Dispatch::Config::CallerDepth = 1;

#to avoid garbled characters by Data::Dumper.
#But Data::Dumper (useperl=1) is slower than xs (c code).
{ package Data::Dumper;   sub qquote { return shift; } }
$Data::Dumper::Useperl = 1;

my $CONF = {
    dispatchers => [qw/file screen/],
    file        => {
        class     => 'Log::Dispatch::File',
        min_level => 'debug',
        filename  => '/home/endo/tmp/test.log',
        mode      => 'append',
        format    => '[%d] [%p] %m at %P line %L %n',
    },
    screen => {
        class     => 'Log::Dispatch::Screen',
        min_level => 'warning',
        stderr    => 1,
        format    => '[%d] [%p] %m at %P line %L %n',
    },
};

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

    Log::Dispatch::Config->configure( $self );
    $self->{base_logger} = Log::Dispatch::Config->instance;

    return $self;
}


# get_attrs_global() & get_attrs() are implemented
#   for Log::Dispatch::Configurator (abstract class).
# http://search.cpan.org/perldoc?Log%3A%3ADispatch%3A%3AConfigurator
sub get_attrs_global {
    my ($self) = @_;
    return {format      => undef,
            dispatchers => $CONF->{dispatchers} };
}
sub get_attrs {
    my ($self,$atri_key) = @_;
    return $CONF->{$atri_key};
}

sub pre_conv_msgs {
    my ($self,@org_msgs) = @_;

    my @new_msgs;
    #TODO? add $ENV{REMOTE_USER} if you need login user id.
    for my $msg ( @org_msgs ){
        $msg = Dumper($msg) if ref($msg); # display for reference value
        push(@new_msgs,Encode::encode('utf8',$msg));
    }
    return \@new_msgs;
}

sub debug {
    my ($self,@org_msgs) = @_;
    $self->{base_logger}->debug( @{$self->pre_conv_msgs(@org_msgs)} );
}
sub info {
    my ($self,@org_msgs) = @_;
    $self->{base_logger}->info( @{$self->pre_conv_msgs(@org_msgs)} );
}
sub warn {
    my ($self,@org_msgs) = @_;
    $self->{base_logger}->warn( @{$self->pre_conv_msgs(@org_msgs)} );
}
sub error {
    my ($self,@org_msgs) = @_;
    $self->{base_logger}->error( @{$self->pre_conv_msgs(@org_msgs)} );
}

1;
__END__