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; $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', ) ); $dispatcher->add( Log::Dispatch::File->new( name => 'queries', min_level => 'debug', # Log::Dispatch::File: filename => $path_to_app . '/logs/sql.txt', 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;