package Local::QueryLogger; # TODO - apache fastcgi process can't find location of calling apps' logs dir # creates 2 files, '%d{yyyy_MMdd}_sql.log' with 0660 permissions, another with # todays date but 644 permissions (apache fastcgi process can't create this one) use DateTime; use Data::Printer; use Term::ANSIColor; use FindBin qw($Bin); # warn $Bin; use Log::Dispatch::File::Rolling; use Moo; use Local::MooX::Types qw(String); has environment_name => ( is => 'lazy', builder => sub { # ddp %ENV; return ( grep $ENV{$_}, qw/RDBO_DEBUG SQL_TRACE/ ) ? 'devel' : 'deployment'; } ); has dispatcher => ( is => 'lazy' ); sub _build_dispatcher { my $self = shift; my $dispatcher = Log::Dispatch->new; my $env_name = $self->environment_name; # warn $env_name; if ( $env_name eq 'devel' ) { $dispatcher->add( Log::Dispatch::File->new( permissions => 0660, min_level => 'info', filename => 'logs/devel.sql', newline => 0, name => 'devel', mode => 'append', ) ) } elsif ( $env_name eq 'deployment' ) { $dispatcher->add( Log::Dispatch::File::Rolling->new( permissions => 0660, min_level => 'info', # filename => "logs/${today}_sql.log", # will be relative to start script dir filename => 'logs/%d{yyyy_MMdd}.sql', # will be relative to start script dir newline => 0, name => 'deployment', mode => 'append', ) ) } else { die "$env_name is not a recognisable environment name" } return $dispatcher; } our $CurrentUsername; # set later on login # my $today = DateTime->today->ymd; =begin # Log::Dispatch::FileWriteRotate: use Log::Dispatch::FileWriteRotate; $dispatcher->add( Log::Dispatch::FileWriteRotate->new( min_level => 'info', # will be passed to File::Write::Rotate dir => '/home/raj/apps', prefix => 'query', suffix => '.log', period => 'daily', size => 25*1024*1024, histories => 1000, # 0 keeps no histories ) ); =cut =begin 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 log_query { my ($self, $str, @bind) = @_; # debug($str); # try to emulate output of Rose::DB::Object::QueryBuilder : { my $key_words = join '|', '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/(ORDER BY)(?!\n)/\n$1\n /; $str =~ s/(GROUP BY)(?!\n)/\n$1\n /; $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] %s\n[%s]", Local::Utils::time_now, $str, join ', ', # truncate any long @bind elements at 100 chars: map { length($_) > 103 ? substr($_, 100).'...' : $_ } @bind; }; if ( $self->environment_name eq 'devel' ) { print STDERR $divider, "\n"; print STDERR color('yellow'); print STDERR $query, "\n"; print STDERR color('reset'); # ie color('white'); print STDERR $divider, "\n\n"; } # send to logger 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 ); } 1;