• 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 $path_to_app); # to make available to _warn()
	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 IO::All;

    use Sub::Exporter -setup =>
        { exports => [ qw(set_querylog_args clear_querylog_args) ] };

	$cfg = LIMS::Local::Config->instance;
	$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 ) { # warn Dumper \%ENV;
		return 0 unless grep $ENV{$_}, @ENV_OK; # killing print run:
        # only want devel server or by specific request:
		# CORE::warn($warn) if ( grep $ENV{$_}, @ENV_OK ) and not $SKIP_LOG_QUERY;
	}
	else { CORE::warn($warn) }

	# dump process size info to stdout if devel server or rdbo_debug:
	if ( $warn !~ /^Making method/ ) { # && grep $ENV{$_}, @ENV_OK ) {
        my $process_size = `ps -p $$ -o size=`+0;
        if ( $ENV{FAST_CGI} ) {
            my $logfile = $path_to_app . '/logs/processes/' . $$ . '.csv'; # warn $logfile;
            my $line = join ',', $time_now, $process_size;
            io($logfile)->append($line, "\n");
        }
        else {
            CORE::warn sprintf "* process-size=%s\n", $process_size;
		}
	}
}

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