package Local::QueryLogger;

=begin
uses SQL::Abstract::Tree for query formtting if SQLAT_QUERY_FORMAT env param
    set, else manual formatting. Problems with SQLAT:
* doesn't split SELECT vars to new-line if fill_in_placeholders() used
* doesn't insert NULL's for undef values if fill_in_placeholders() used
* new-lines 'ORDER BY' inside 'GROUP_CONCAT'
* placeholder_surround => [GREEN, RESET] causes Bareword "GREEN" not allowed ...
* require profile => 'none' for log-files which doesn't format query, also causes
    "Use of uninitialized value in concatenation (.) or string at
        /home/raj/perl5/lib/perl5/SQL/Abstract/Tree.pm line 526"

uses Log::Dispatch::File for sql query logging (relies on separate cron to
    rotate files)
* development => logs/devel.sql
* deployment  => logs/{yyyy-mm-dd}.sql
* test scripts => logs/test.sql (if $ENV{LOG_QUERIES} & $ENV{SQL_TRACE} set)

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 'LOG_QUERIES' env param set true
=cut

use 5.26.0;

use Try::Tiny;
use Local::Utils;
use B 'perlstring';
use Data::Printer alias => 'p';
use Term::ANSIColor::Simple;
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 SQLAT fill_in_placeholders:
has dbh => ( is => 'ro' );

our $CurrentUsername; # set later if app has login & session
# to suppress query logging (eg when www-data has no write permission):
our $NO_QUERY_LOGS; # no longer in use but retained for legacy scripts - file
# logging (if required) now explicitly set in creation of dbix object

# use SQL::Abstract::Tree to format query (see above for issues)
use constant SQL_ABSTRACT_TREE => $ENV{SQLAT_QUERY_FORMAT} || 0;
# should SQL::Abstract::Tree (if used) do placeholder substitution (see above for issues):
use constant FILL_IN_PLACEHOLDERS => 0; # substitution done manually if set to '0'
# $Bin always <D2-app>/bin (location of app.psgi), even if called via .cgi
use constant LOG_DIR => $Bin . '/../logs';

#===============================================================================
sub log_query {
    my ($self, $str, @bind) = @_; # p $str; p $self->environment_name;

    # suppress logging if test scripts (unless SQL_TRACE explicitly set):
    return if $self->environment_name eq 'test' and not $ENV{SQL_TRACE};

    SQL_ABSTRACT_TREE
        ? $self->_sqlat_format($str, @bind)
        : $self->_manual_format($str, @bind);
}
#===============================================================================

sub _manual_format {
    my ($self, $str, @bind) = @_; # p $str;

=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
    $str =~ s/\s+/ /g; # convert all white-spaces to single-space

    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 '|', 'left join', 'inner join', 'left outer',
            'group by', 'order by', qw( select from where join date_sub curdate
                interval show columns values group_concat limit ); # p $key_words;
        # upper-case key-words (if not already):
        $query =~ s/\b($key_words)\b/uc $1/eg; # warn $query;
        # separate SELECT fields into one-per-line if more than 1 (ie has comma):
		if ( my ($cols) = $query =~ /SELECT (.*) FROM/ ) { # p $cols;
           # commas (& optional space) except placeholders (?,?,?,etc) & within brackets:
            if ( $cols =~ s/(\,(?!\s?\?|[^(]+\)))(?!\n)/$1\n\t/g ) { #  p $cols;
                # $cols needs a leading space to match 1-space indent for items >1:
                $query =~ s/SELECT (.*) FROM/SELECT\n\t $cols FROM/; # 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/\b(SET|FROM|VALUES|LIMIT|OFFSET|GROUP BY)\b(?!\n)/\n$1/g; # 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\t/; # 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 ( $self->environment_name eq 'deployment' ) {
        print STDERR $divider, "\n";
        print STDERR color($query)->cyan, "\n"; # eg color($var)->foreground->background
        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 );
}

# use SQL::Abstract::Tree to format query:
sub _sqlat_format {
    my ($self, $str, @bind) = @_; # p $str;

    # 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 ( $self->environment_name eq 'deployment' ) {
        print STDERR $divider, "\n";
        print STDERR $console_query, "\n";
        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('none', $str, @bind); # causes 'uninitialized value' warn in SQLAT#526

    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 => FILL_IN_PLACEHOLDERS, # 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;
}

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'
                # temporarily replace single-quotes (confuses dbh->quote method):
                $val =~ s/\Q'/%%single_quote%%/; # escape single-quotes # eg o'connor
                $val = $self->dbh->quote($val); # warn $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 & single-quote symbols:
    $query =~ s/%%question_mark%%/?/g;
    $query =~ s/%%single_quote%%/\\'/g; # escape the escape command !
        # 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;