package LIMS::Local::LogDispatch;
use Log::Dispatch;
use Log::Dispatch::File;
use Log::Dispatch::Screen;
use Log::Dispatch::Email::MailSendmail;
use POSIX qw(strftime);
use Time::HiRes qw(gettimeofday tv_interval);
use LIMS::Local::Config;
use Data::Dumper;
require Exporter;
@ISA = 'Exporter'; # required in Perl 5.10
@EXPORT = qw(
log_dispatch
);
use strict;
use warnings;
sub log_dispatch {
my $self = shift; # warn Dumper $self->param('_log_dispatch');
# create dispatcher as param if it doesn't already exist:
if (! $self->param('_log_dispatch') ) { # warn 'HERE';
my $config = LIMS::Local::Config->instance; # warn Dumper $config;
my $user = $self->authen->username; # warn Dumper $user;
my $t0 = $self->param('t0'); # warn Dumper $t0;
my $dispatcher = Log::Dispatch->new(
callbacks => sub {
my %h = @_; chomp $h{message};
my $timestamp = strftime "[%d-%b-%Y %H:%M:%S]", localtime;
return sprintf "%s %s %s [%.4f sec]\n",
$timestamp,
$user ? ( uc $user ) : 'USER_UNDEFINED', # avoid undef warning on uc
$h{message},
tv_interval $t0, [gettimeofday];
},
);
my $log_dispatch_mods =
$config->{log_dispatch}->{LOG_DISPATCH_MODULES}; # warn Dumper $log_dispatch_mods;
foreach my $entry (@$log_dispatch_mods) { # warn Dumper $entry;
my $module = $entry->{module};
my %args =
map { $_ => $entry->{$_} }
grep { $_ ne 'module' } # already used it for $module
keys %$entry; # warn Dumper \%args;
$dispatcher->add(
$module->new(%args),
);
}
$self->param( _log_dispatch => $dispatcher ); # warn Dumper $dispatcher;
}
die 'log dispatcher creation failed' unless $self->param('_log_dispatch');
# else { warn 'ALREADY IN STASH' }
return $self->param('_log_dispatch');
}
1;