package LIMS::Local::QueryLog;
{ # mst fix for failure to re-chmod files after rotation in absence of server restart:
package Log::Dispatch::File;
use Class::Method::Modifiers;
after log_message => sub { delete $_[0]->{chmodded} } # safe to retain after LDF fixed
}
# TODO: see __PACKAGE__ensure_warn_handler_capture if using Apache FastCgiServer
use strict;
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 $mode $db); # to make available to _warn()
use POSIX qw(strftime);
use IO::All;
# use LIMS::DB; # only required by format_query() - not working yet
use Data::Printer;
use LIMS::Local::Utils;
use LIMS::Local::Config;
use Log::Dispatch;
use Log::Dispatch::File;
use Sub::Exporter -setup =>
{ exports => [ qw(set_querylog_args clear_querylog_args) ] };
# create new Log::Dispatch::File object (needs to be inside BEGIN block):
my $new_ldf = sub { Log::Dispatch::File->new(@_) };
# $db = LIMS::DB->new_or_cached; # only required by format_query() - not working yet
$cfg = LIMS::Local::Config->instance;
$path_to_app = $cfg->{path_to_app_root};
$dispatcher = Log::Dispatch->new;
# are we running under fastcgi (deployment) or lims_server (development) mode?
$mode = $ENV{ROSEDB_DEVINIT} =~ /devinit_prod/
? 'deployment' : 'development';
{ # debug level log for SELECT/SHOW queries (fixed filename, rotated file):
# deployment file permission needs to be group-writable to allow cron user to rotate:
my $permission = ( $mode eq 'deployment' ) ? 0660 : 0640;
my %args = (
name => 'queries',
mode => 'append', # happens anyway if close_after_write set to 1
filename => "${path_to_app}/logs/${mode}.sql",
min_level => 'debug',
permissions => $permission,
# required to force file to be created after rotation, forces append mode:
close_after_write => ( $mode eq 'deployment' ), # not required otherwise
);
my $o = &$new_ldf(%args);
$dispatcher->add($o);
}
{ # info level log for UPDATE/INSERT/DELETE statements (deployment only)
# production system = archived date-stamped file
my $today = LIMS::Local::Utils::today->ymd; # warn $today;
my %args = (
name => 'edits',
mode => 'append', # happens anyway with close_after_write set to 1
filename => "${path_to_app}/logs/${today}.sql", # eg 2019-04-04.sql
min_level => 'info',
permissions => 0660, # to allow cron user to rotate
# required to force file to be created after rotation, forces append mode:
close_after_write => 1,
);
my $o = &$new_ldf(%args);
$dispatcher->add($o);
}
$SIG{__WARN__} = \&_warn_handler;
}
sub set_querylog_args {
$LogArgs = shift;
# $LogArgs{username} = $username;
}
sub clear_log_args {
# %LogArgs = ();
}
sub format_query { # TODO: needs more work
my $str = shift;
$str =~ s/\((.*)\)$//; # remove & capture vars at end of string
my @bind = split /,\s*/, $1;
my $query = Local::Utils::format_query($db, $str, @bind);
# remove blank lines (lines without alphanumeric characters):
$query = join "\n", grep { $_ =~ /\w+/ } split "\n", $query;
return $query;
}
# 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} || 'unknown' ),
uc $cfg->{settings}{_centre},
# format_query($warn); # not quite there yet
$warn;
}; # CORE::warn(&$msg);
unless ($SKIP_LOG_QUERY) { # warn 'here';
if ( $mode eq 'deployment' ) { # split edits from select queries:
if ( $warn =~ /^(INSERT|UPDATE|DELETE)/ ) { # ie db edits
$dispatcher->log(level => 'info', message => &$msg); # warn 'here';
}
elsif ( $warn =~ /^SELECT|SHOW/ ) { # non-edits
$dispatcher->log(level => 'debug', message => &$msg); # warn 'here';
}
}
# development has single file for combined queries:
elsif ( $warn =~ /^(INSERT|UPDATE|DELETE|SELECT|SHOW)/ ) {
$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 ) { # p %ENV;
return 0 unless grep $ENV{$_}, @ENV_OK;
# dump queries to stdout, unless configured to skip:
CORE::warn($warn) unless $SKIP_LOG_QUERY;
}
else { CORE::warn($warn) } # warn everything else
# 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; # moved to 'else' Nov/2016
if ( $ENV{FAST_CGI} ) {
my $logfile = $path_to_app . '/logs/processes/' . $$ . '.csv'; # warn $logfile;
# my $line = join ',', $time_now, $process_size;
my $line = join ',', $time_now, 'warn:'.$warn; # eg will get here for script errs
# io($logfile)->append($line, "\n"); # stopped logging Nov/2016
}
else {
my $process_size = `ps -p $$ -o size=`+0;
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;
