RSS Git Download  Clone
Raw Blame History
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;