• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Local::QueryLog;

use strict;

$|++;

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

    use Log::Dispatch;
    use Log::Dispatch::File;
    use Log::Dispatch::File::Rolling;
#    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;
	my $path_to_app = $cfg->{path_to_app_root};
    
    $dispatcher = Log::Dispatch->new;
    
    my $sql_file; # set inside blocks below:
    
    # UPDATE/INSERT/DELETE statements (devel database; fixed logfile):
    if ($ENV{ROSEDB_DEVINIT} =~ /devinit_devel/) {
        $dispatcher->add(
            Log::Dispatch::File->new(
                name        => 'edits',
                min_level   => 'info',
                # Log::Dispatch::File:
                filename    =>  $path_to_app . '/logs/dev_sql.log',
                mode        => 'append',
            )
        );
        $sql_file = 'dev_sql.txt';
    }
    # UPDATE/INSERT/DELETE statements (production database; rolling logfile):
    else {
        $dispatcher->add(
            Log::Dispatch::File::Rolling->new(
                name        => 'edits',
                min_level   => 'info',
                # Log::Dispatch::File::Rolling:
                filename    =>  $path_to_app . '/logs/%d{yyyy_MMdd}_sql.log',
                permissions => 0666,
                mode        => 'append',
            )
        );
        $sql_file = 'sql.txt';
    }
    
    # SELECT queries:
    $dispatcher->add(
        Log::Dispatch::File->new(
            name        => 'queries',
            min_level   => 'debug',
            # Log::Dispatch::File:
            filename    => $path_to_app . '/logs/' . $sql_file,
            permissions => 0666,
            mode        => 'append',
        )
    );

    $SIG{__WARN__} = \&_warn_handler;
}

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

sub clear_log_args {
#    %LogArgs = ();
}

# need to call this from app per-request (eg in cgiapp_prerun) if using fastcgi
# in non-external mode - CGI::Fast calls FCGI which re-defines $SIG{__WARN__};
# doesn't cause the same problem when app run as FastCgiExternalServer process
sub ensure_warn_handler_capture { $SIG{__WARN__} = \&_warn_handler; }

sub _warn_handler {
    my $warn = shift;

    # my $divider = '-+-' x 10;	
    # $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 $msg = sprintf "[%s] %s\n%s\n", $timestamp, uc $LogArgs->{user}, $warn;

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