• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Local::QueryLog;

use strict;
use Data::Dumper;

use Readonly;
Readonly::Array my @STATEMENTS 
	=> ( qw/SELECT INSERT UPDATE DELETE SHOW/, 'Making method' );
Readonly::Array my @ENV_OK => qw(DEVEL_SERVER RDBO_DEBUG_ON);

our $SKIP_LOG_QUERY; # allow specific queries to be exempted from log files (eg user msgs)

$|++;

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 (production database; rolling logfile):
    if ($ENV{ROSEDB_DEVINIT} =~ /devinit_prod/) {
        $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';
    }
    # UPDATE/INSERT/DELETE statements (devel database; fixed logfile):
    else {
        $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';
    }
    
    # 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 || return; # warn $SKIP_LOG_QUERY;

    my $time_now = LIMS::Local::Utils::date_and_time_now;
    
    # my $divider = '-+-' x 10;	
    # $warn =~ s/\s{2}(JOIN)/\n\t$1/g; # line-break & tab JOIN's
    my $msg = sub { # reading pid id & size kills print run (timeout):
#        sprintf "[%s] %s [%s|%s|%s]\n%s\n", # [time] user [centre, pid ID & size] query:
#            $time_now, uc $LogArgs->{user}, uc $cfg->{settings}{_centre},
#            $$, format_number(`ps -p $$ -o size=`+0), $warn;
        sprintf "[%s] %s [%s]\n%s\n", # [time] user [centre] query:
            $time_now, uc $LogArgs->{user}, uc $cfg->{settings}{_centre}, $warn;
    }; # CORE::warn(&$msg);

	unless ($SKIP_LOG_QUERY) { # warn 'here';
		if ($warn =~ /^(INSERT|UPDATE|DELETE)/) { # ie db edits
			$dispatcher->log(level => 'info', message => &$msg); # warn 'here';
		}
		elsif ($warn =~ /^SELECT|SHOW/) { # SELECT|SHOW, etc - ie non-edits
			$dispatcher->log(level => 'debug', message => &$msg); # warn 'here';
		}
	}
#    open my $fh, '>>'.'/tmp/env.txt' or die $!;
#    while( my ($k,$v) = each %ENV ) {
#      print $fh "$k: $v\n";
#    }

    # don't want RDBO::Manager or SQL query statements in apache's error.log
    if ( grep { $warn =~ /\A$_/ } @STATEMENTS ) {
        # only want devel server or by specific request:
		return 0 unless ( grep $ENV{$_}, @ENV_OK ); 
	}    
    CORE::warn($warn) unless $SKIP_LOG_QUERY; # print $fh $warn;

	# dump process size info to stdout if devel server or rdbo_debug:
	if ( $warn !~ /^Making method/ && grep $ENV{$_}, @ENV_OK ) {
		CORE::warn(sprintf "* process-size=%s\n", 
            LIMS::Local::Utils::format_number(`ps -p $$ -o size=`+0)
		);
	}
}

=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;