• Files
• Commits
• Log
• Graph
• Stats

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

our $CurrentUsername; # set later if app has login & session

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 '|',
            '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/(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";
    }
# log query, if not test script (unless LOG_QUERIES & SQL_TRACE explicitly set):
    return if $environment eq 'test' and not $ENV{LOG_QUERIES};

    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    => 'logs/devel.sql',
                newline     => 0,
                name        => 'devel',
                mode        => 'append',
            )
        )
    }
    elsif ( $environment eq 'test' ) {
        $dispatcher->add(
            Log::Dispatch::File->new(
                permissions => 0600,
                min_level   => 'info',
                filename    => 'logs/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    => "logs/${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  => 'logs/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       => 'logs', # 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;