RSS Git Download  Clone
Raw Blame History
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;