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__