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
dumps query to log-file if 'log_query' arg passed in call to dbix(),
    or or 'LOG_QUERIES' env param set true
=cut

use feature 'say';

use Try::Tiny;
use Local::Utils;
use Modern::Perl;
use B 'perlstring';
use Data::Printer alias => 'p';
use Term::ANSIColor;
use FindBin qw($Bin); # warn $Bin;
use Log::Dispatch::File;
use SQL::Abstract::Tree; # cannot be used with Carp::Always::Color - deep recursion
#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 );
# dbh only required if not using SQT fill_in_placeholders:
has dbh => ( is => 'ro' );

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 <D2-app>/bin (location of app.psgi), even if called via .cgi
my $log_dir = $Bin . '/../logs';

=begin # SQL::Abstract::Tree method of formatting query:
sub log_query {
    my ($self, $str, @bind) = @_; # p $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};

    # my $thread_id = $self->dbh->{mysql_thread_id};
    my $divider = '-' x 70;
    my $console_query = sprintf "[%s]\n%s",
        Local::Utils::time_now, $self->format_query('console', $str, @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'); # don't need if using SQT format_query()
        print STDERR $console_query, "\n";
        #print STDERR color('reset'); # ie color('white');
        print STDERR $divider, "\n\n";
    }
# log query to file if required (test scripts need LOG_QUERIES & SQL_TRACE envs set):
    return unless $self->use_log_file; # warn 'here';

    my $query = sprintf "[%s]\n%s",
        Local::Utils::time_now,
        $self->format_query('console_monochrome', $str, @bind);

    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 );
}

sub format_query { # used if SQL::Abstract::Tree format_query used
    my ($self, $type, $str, @bind) = @_; # console or console_monochrome (for files)

    my %args = (
        profile => $type,
        fill_in_placeholders => 0, # to override default '1'
        # placeholder_surround => [GREEN, RESET], # Bareword "GREEN" not allowed ....
    );
    my $formatter = SQL::Abstract::Tree->new(\%args); # p $formatter;
    # customise:
    $formatter->indentmap->{from} = 0; # don't indent 'FROM'
    $formatter->indentmap->{'inner join'} = 1;
    $formatter->indentmap->{'left outer join'} = 1; # indents but doesn't
    # colorise - delete 'OUTER' instead:
    # $str =~ s/(LEFT) OUTER (JOIN)/$1 $2/g; # for colour coding
    delete $formatter->indentmap->{on}; # don't insert new-line before 'ON'
    # either use SQT fill_in_placeholders => 1, or substitute_placeholders():
    if (! $formatter->fill_in_placeholders ) {
        $str = $self->substitute_placeholders($str, @bind);
        { # hide some characters which confuse SQLAT:
            $str =~ s/\Q?/%%question_mark%%/g; # eg '? myeloproliferative disorder'
            $str =~ s/\Q(/%%L_paren%%/g; # eg 'Follow-up CML (PB)'
            $str =~ s/\Q)/%%R_paren%%/g; # eg 'Follow-up CML (PB)'
        }
    }
    # protect SQLAT from broken queries; @bind only needed if fill_in_placeholders() used
    my $query = try { $formatter->format($str, \@bind) }
    || sprintf '%s [%s]', $str, join ', ', @bind; # warn perlstring $query;
    { # reverse hidden chars:
        $query =~ s/%%question_mark%%/?/g;
        $query =~ s/%%L_paren%%/(/g;
        $query =~ s/%%R_paren%%/)/g;
    }
    return $query; # not worth the hassle:
    # separate SELECT fields into one-per-line:
    if ( my ($cols) = $query =~ /SELECT (.*)/ ) {  # warn $cols;
        $cols =~ s/(\,(?!\s?\?))(?!\n)/$1\n   /g;   # warn $cols;
        $query =~ s/SELECT (.*)/SELECT\n    $cols/; # warn $query;
    }
    return $query;
}
=cut

#=begin # manual method of formatting query:
sub log_query {
    my ($self, $str, @bind) = @_; # p $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};

=begin # manual expansion of @bind into comma-delimited string:
   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;
    };
=cut
    my $query = sprintf "[%s]\n%s",
        Local::Utils::time_now,
        $self->substitute_placeholders($str, @bind); # p $query;

    { # 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 values);
        # upper-case key-words:
        $query =~ s/\b($key_words)\b/uc $1/eg; # p $query;
        # separate SELECT fields into one-per-line:
		if ( my ($cols) = $query =~ /SELECT (.*) FROM/ ) {  # p $cols;
			# commas (& optional space) - except placeholders (?,?,?,etc):
			$cols =~ s/(\,(?!\s?\?))(?!\n)/$1\n\t/g;  # p $cols;
			$query =~ s/SELECT (.*) FROM/SELECT\n\t $cols FROM/; # p $query;
		}
        # new-line after 'SELECT' (if not already), then indent:
        $query =~ s/(SELECT)(?!\n)/$1\n  /; # p $query;
        # new-line before 'ORDER BY' (only after 'FROM' - don't re-format
        # inside a 'GROUP_CONCAT'):
        $query =~ s/(FROM .*) (ORDER BY)(?!\n)/$1\n$2/; # p $query;
        # new-line before key-words:
		$query =~ s/(FROM|VALUES|LIMIT|OFFSET|GROUP BY)(?!\n)/\n$1/; # say $query;
        # new-line & tab in front of JOIN's:
        $query =~ s/((INNER|LEFT OUTER)\s?JOIN)(?!\n)/\n\t $1/g; # p $query;
        # new-line before & after 'WHERE', then indent:
        $query =~ s/(WHERE)(?!\n)/\n$1\n  /; # p $query;
        # tabs -> 2 spaces
        $query =~ s/\t/  /g;
    } # p $query;

    # my $thread_id = $self->dbh->{mysql_thread_id};
    my $divider = '-' x 70;

# 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 to file if required (test scripts need LOG_QUERIES & SQL_TRACE envs set):
    return unless $self->use_log_file; # warn 'here';

    if ( $CurrentUsername ) { # only set if app has login & session
        $query = join ' ', uc $CurrentUsername, $query;
    }
    my $log_entry = 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 );
}
#=cut

sub substitute_placeholders { # p $_[0];
    my ($self, $query, @bind) = @_; # p $query; p \@bind;
=begin # already visited if using Local::DB::dbix
    # expand omniholders if present (?? -> ?,?,?...) - pass query as ref so
    # changes persist:
    $self->dbix->expand_omniholder(\$query, \@bind); # p $query;
  # uncomment this to fill in placeholders by SQL::Abstract::Tree:
  # return $query, @bind; # ? doesn't work for text file
=cut

    { # append undef's to end of @bind to match no. of placeholders for trailing
      # cols with db default vals which are not supplied in query eg created_at,
      # updated_at, etc; will be converted to 'NULL' later:
        my $n = () = $query =~ /\Q?/g; # warn $n; warn scalar @bind;
        push @bind, undef for ( 1 .. $n - scalar @bind ); # p \@bind;
    }
    # successively replace each '?' in query with next element of @bind array:
    for my $val (@bind) { # warn '=' x 20; p "val:$val; length:". length $val;
        if ( length $val ) { # warn $val; # "defined $val" doesn't work here
            # quote anything other than numbers
            unless ( Scalar::Util::looks_like_number($val) ) {
                # temporarily replace any '?' in $val (confuses the placeholder substitution):
                $val =~ s/\Q?/%%question_mark%%/g; # eg '? myeloproliferative disorder'
                $val = $self->dbh->quote($val);
            }
        }
        else { $val = 'NULL' } # warn $val; # p $query;
        # do placeholder substitution:
        my $ok = $query =~ s/\Q?/$val/; # warn $ok;
    } # p $query; warn '=' x 20;
    $query =~ s/= NULL\b/IS NULL/g; # if query contained '= ?' for an empty placeholder
    # replace temporary question-mark symbols:
    $query =~ s/%%question_mark%%/?/g;
        # warn $query;
    return $query;
}

=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;