RSS Git Download  Clone
Raw Blame History
package LIMS::Local::QueryLog;

use strict;

$|++;

BEGIN {
	use vars qw($LogArgs $cfg);
	use POSIX qw(strftime);

    use Log::Dispatch; # use Log::Dispatch::File::Rolling;
    use Log::Dispatch::File;
#    use Log::Dispatch::FileRotate; # huge performance penalty

    use LIMS::Local::Config;
	use Data::Dumper;
	
    use Sub::Exporter -setup =>
        { exports => [ qw(set_querylog_args clear_querylog_args) ] };

	$cfg = LIMS::Local::Config->instance;
	
    $SIG{__WARN__} = \&_warn_handler;
}

sub set_querylog_args {
    $LogArgs = shift;
#    $LogArgs{username} = $username;
}

sub clear_log_args {
#    %LogArgs = ()
}

sub _warn_handler {
    my $warn = shift;

    my $dispatcher = Log::Dispatch->new;
    # my $divider = '-+-' x 10;
	
    $dispatcher->add(
        Log::Dispatch::File->new(
            name        => 'edits',
            min_level   => 'info',
            # Log::Dispatch::File::Rolling:
#           filename    => "$path_to_app_root/logs/lims_sql_%d{yyyy_MMdd}.log",
            filename    => $cfg->{path_to_app_root} . '/logs/sql.log',
            permissions => 0666,
            mode        => 'append',
        )
    );

    $dispatcher->add(
        Log::Dispatch::File->new(
            name        => 'queries',
            min_level   => 'debug',
            filename    => $cfg->{path_to_app_root} . '/logs/sql.txt',
            permissions => 0666,
            mode        => 'append',
        )
    );

    # $warn =~ s/\s{2}(JOIN)/\n\t$1/g; # line-break & tab JOIN's

    my $timestamp = strftime "[%d-%b-%Y %H:%M:%S]", localtime;

    my $output = sprintf "%s %s\n%s\n", $timestamp, uc $LogArgs->{user}, $warn;

    if ($warn =~ /^(INSERT|UPDATE|DELETE)/) { # SELECT|SHOW, etc - ie non-edits
        $dispatcher->log(level => 'info', message => $output);
    }
    elsif ($warn =~ /^SELECT/) {
        $dispatcher->log(level => 'debug', message => $output);
    }
    
#    open my $fh, '>>'.'/tmp/env.txt' or die $!;
#    while( my ($k,$v) = each %ENV ) {
#      print $fh "$k: $v\n";
#    }
    
    # don't want SQL statememts in apache's error.log
    return if (
        ( $warn =~ /^Making method/
         || grep { $warn =~ /\A$_/ } qw/SELECT INSERT UPDATE DELETE SHOW/ )
        && $ENV{ROSEDB_DEVINIT} !~ /devel/
    );
    
    CORE::warn($warn); # print $fh $warn;
}

=begin # FileRotate causes serious performance hit here
    $dispatcher->add(
        Log::Dispatch::FileRotate->new(
            name        => 'query',
            min_level   => 'debug',
            filename    => "$path_to_app_root/logs/sql.txt",
            permissions => 0666,
            mode        => 'append',
            DatePattern => 'yyyy-MM-dd', # every day # or size => 1, # operates in date or size mode
        )
    );
=cut

1;