package Local::QueryLogger; =begin uses Log::Dispatch::File for sql query logging * deployment => logs/{yyyy-mm-dd}.sql * development => logs/devel.sql * test scripts => logs/test.sql (if $ENV{LOG_QUERIES} & $ENV{SQL_TRACE} set) relies on separate cron to rotate files dumps query to STDERR if running as devel, or if test script with $ENV{SQL_TRACE} set =cut use Local::Utils; use Modern::Perl; use Data::Printer; use Term::ANSIColor; use FindBin qw($Bin); # warn $Bin; use Log::Dispatch::File; #use Log::Dispatch::File::Rolling; # creates redundant file + wrong file permissions #use Log::Dispatch::FileWriteRotate; # no advantage over LD::File use Moo; has environment_name => ( is => 'lazy', builder => sub { # ddp %ENV; return # test for harness 1st as sql_trace can still be enabled in test mode: $ENV{HARNESS_VERSION} ? 'test' # HARNESS_VERSION supplied by Test::Harness : $ENV{SQL_TRACE} ? 'devel' : 'deployment'; } ); has dispatcher => ( is => 'lazy' ); # _build_dispatcher # log queries to file: has use_log_file => ( is => 'rw', required => 1 ); our $CurrentUsername; # set later if app has login & session #=============================================================================== # no longer in use but retained for legacy scripts - file logging now explicitly set our $NO_QUERY_LOGS; # to suppress query logging (eg when www-data has no write permission) #=============================================================================== # $Bin always /bin (location of app.psgi), even if called via .cgi my $log_dir = $Bin . '/../logs'; sub log_query { my ($self, $str, @bind) = @_; # ddp $str; my $environment = $self->environment_name; # ddp $environment; # suppress logging if test scripts (unless SQL_TRACE explicitly set): return if $environment eq 'test' and not $ENV{SQL_TRACE}; { # try to emulate output of Rose::DB::Object::QueryBuilder : my $key_words = join '|', 'group_concat', 'left join', 'inner join', 'left outer', 'group by', 'order by', qw(select from where join date_sub curdate interval show columns); $str =~ s/\b($key_words)\b/uc $1/eg; $str =~ s/(SELECT)(?!\n)/$1\n /; # commas (& optional space) - except placeholders (?,?,?,etc): $str =~ s/(\,(?!\s?\?))(?!\n)/$1\n /g; $str =~ s/(FROM)(?!\n)/\n$1\n /; $str =~ s/((INNER|LEFT OUTER)\s?JOIN)(?!\n)/\n\t $1/g; $str =~ s/(WHERE)(?!\n)/\n$1\n /; $str =~ s/((GROUP|ORDER) BY)(?!\n)/\n$1\n /g; $str =~ s/(LIMIT|OFFSET)/\n$1/g; $str =~ s/\t/ /g; # tabs -> 2 spaces } # my $thread_id = $self->dbh->{mysql_thread_id}; my $divider = '-' x 70; my $query = do { no warnings 'uninitialized'; # common for @bind params to be undef sprintf "[%s]\n%s\n[%s]", Local::Utils::time_now, $str, join ', ', # truncate any long @bind elements at 100 chars: map { length($_) > 103 ? substr($_, 100).'...' : $_ } @bind; }; # dump to console unless deployment (test script will only get here if SQL_TRACE set: unless ( $environment eq 'deployment' ) { print STDERR $divider, "\n"; print STDERR color('yellow'); print STDERR $query, "\n"; print STDERR color('reset'); # ie color('white'); print STDERR $divider, "\n\n"; } # warn 'here'; # log query to file if required (test scripts need LOG_QUERIES & SQL_TRACE envs set): return unless $self->use_log_file; # warn 'here'; my $log_entry = $CurrentUsername # only set if app has login & session ? ( sprintf "%s %s\n%s\n", uc $CurrentUsername, $query, $divider ) : ( sprintf "%s\n%s\n", $query, $divider ); # $self->dispatcher->info( $log_entry ); # or to set log level: $self->dispatcher->log( level => 'info', message => $log_entry ); } =begin # was used when $logger->log() called from Local::DB sub log { my ($self, $name, $level, $msg) = @_; # ddp $name; ddp $msg; # ddp $level; if ($CurrentUsername) { # will only exist if app has login & session $msg = join ' ', uc $CurrentUsername, $msg; # prepend username } # ddp $CurrentUsername; ddp $name; ddp $msg; $dispatcher->log_to(name => $name, level => $level, message => $msg); } =cut sub _build_dispatcher { my $self = shift; my $environment = $self->environment_name; # ddp $environment; my $dispatcher = Log::Dispatch->new; if ( $environment eq 'devel' ) { $dispatcher->add( Log::Dispatch::File->new( permissions => 0600, min_level => 'info', filename => "$log_dir/devel.sql", newline => 0, name => 'devel', mode => 'append', ) ) } elsif ( $environment eq 'test' ) { $dispatcher->add( Log::Dispatch::File->new( permissions => 0600, min_level => 'info', filename => "$log_dir/test.sql", newline => 0, name => 'test', mode => 'append', ) ) } elsif ( $environment eq 'deployment' ) { my $today = Local::Utils::today->ymd; $dispatcher->add( Log::Dispatch::File->new( permissions => 0644, min_level => 'info', filename => "$log_dir/${today}.sql", newline => 0, name => 'deployment', mode => 'append', ) ); =begin $dispatcher->add( Log::Dispatch::File::Rolling->new( permissions => 0644, min_level => 'info', # filename is relative to start script so need symlink for fastcgi: filename => "$log_dir/log.sql", # inserts date eg log-{yyyy-MM-dd}.sql newline => 0, name => 'deployment', mode => 'append', ) ); $dispatcher->add( Log::Dispatch::FileWriteRotate->new( min_level => 'info', # will be passed to File::Write::Rotate dir => "$log_dir", # relative to start script dir prefix => 'log', suffix => '.sql', period => 'daily', size => 25*1024*1024, histories => 1000, # 0 keeps no histories ) ); =cut } else { die "$environment is not a recognisable environment name" } return $dispatcher; } 1;