package LIMS::Local::QueryLog;

#===============================================================================
# see logs/README.txt for file permission settings
#===============================================================================

{ # mst fix for failure to re-chmod files after rotation in absence of server restart:
    package Log::Dispatch::File;
    use Class::Method::Modifiers;
    after log_message => sub { delete $_[0]->{chmodded} } # safe to retain after LDF fixed
}

# TODO: see __PACKAGE__ensure_warn_handler_capture if using Apache FastCgiServer

use strict;
use Local::DB;
use SQL::Abstract::Tree; # for pretty-formatting queries
use Data::Printer alias => 'p';
use feature 'say';

use Readonly;
Readonly::Array my @STATEMENTS
	=> ( qw/SELECT INSERT UPDATE DELETE SHOW/, 'Making method' );
Readonly::Array my @ENV_OK => qw(DEVEL_SERVER RDBO_DEBUG_ON);

our $SKIP_LOG_QUERY; # allow specific queries to be exempted from log files (eg user msgs)

$|++;

BEGIN {
	use vars qw($LogArgs $cfg $dispatcher $path_to_app $formatter $mode $db); # to make available to _warn()
	use POSIX qw(strftime);

	use IO::All;
    use LIMS::DB; # only required by format_query()
    use Data::Printer;
    use LIMS::Local::Utils;
    use LIMS::Local::Config;

    use Log::Dispatch;
    use Log::Dispatch::File;

    use Sub::Exporter -setup =>
        { exports => [ qw(set_querylog_args clear_querylog_args) ] };
    # create new Log::Dispatch::File object (needs to be inside BEGIN block):
    my $new_ldf = sub { Log::Dispatch::File->new(@_) };

    $db  = LIMS::DB->new_or_cached; # only required by format_query()
	$cfg = LIMS::Local::Config->instance;
	$path_to_app = $cfg->{path_to_app_root};

    $dispatcher = Log::Dispatch->new;

	# are we running under fastcgi (deployment) or lims_server (development) mode?
    $mode = $ENV{ROSEDB_DEVINIT} =~ /devinit_prod/
		? 'deployment' : 'development';

    { # debug level log for SELECT/SHOW queries (fixed filename, rotated file):
        # deployment file needs to be cron-user-writable to allow script to rotate
        # (if www-data:www-data then it needs to be 666):
        my $permission = ( $mode eq 'deployment' ) ? 0666 : 0640;
		my %args = (
			name => 'queries',
			mode => 'append', # happens anyway if close_after_write set to 1
			filename  => "${path_to_app}/logs/${mode}.sql",
			min_level => 'debug',
			permissions => $permission,
            # required to force file to be created after rotation, forces append mode:
            close_after_write => ( $mode eq 'deployment' ), # not required otherwise
		);
		my $o = &$new_ldf(%args);
		$dispatcher->add($o);
	}

    { # info level log for UPDATE/INSERT/DELETE statements (deployment only)
        # production system = archived date-stamped file
		my %args = (
			name => 'edits',
			mode => 'append', # happens anyway with close_after_write set to 1
			filename  => "${path_to_app}/logs/today.sql",
			min_level => 'info',
            # needs to be cron-user-readable to allow script to archive:
			permissions => 0644, # 640 or if www-data:www-data then it needs to be 644
            # required to force file to be created after rotation, forces append mode:
            close_after_write => 1,
		);
		my $o = &$new_ldf(%args);
		$dispatcher->add($o);
    }

    $SIG{__WARN__} = \&_warn_handler;
}


sub set_querylog_args {
    $LogArgs = shift;
#    $LogArgs{username} = $username;
}

sub clear_log_args {
#    %LogArgs = ();
}

sub format_query { # p $_[0];
    chomp( my $str = shift ); # p $str; # remove any trailing new-line (eg haem data)
    my $type = shift || 'console'; # optional override for files

    # some queries have "bind params: foo, bar, etc", others have (foo, bar, etc)
    # remove & capture vars at end of string, matching across multiple lines:
    $str =~ s/- bind params: (.*)//s;   # "bind params: foo, bar, etc"
    $str =~ s/\(([^(]*)\)$//s;          # "(foo, bar, etc)"
    my @bind = split /,\s*/, $1;        # p $str; p $1; p \@bind;

	# expand omniholders if present (?? -> ?,?,?...) - pass query as ref so
    # changes persist:
    Local::DB::expand_omniholder($db, \$str, \@bind); # p $str;

    # replace each '?' in query with next element of @bind array; can't supply
    # NULL vals after last defined $val in @bind eg when query has placeholders
    # for auto-insert cols at end of list (eg created_at, updated_at, etc)
    for my $val (@bind) {
        $val = $db->dbh->quote($val) # quote anything other than numbers
            # defined $val doesn't work here:
            if length $val and not Scalar::Util::looks_like_number($val); # p $val;
        $val //= 'NULL'; # warn $val;
        $str =~ s/\Q?/$val/;
    } # p $str;

    $formatter = SQL::Abstract::Tree->new({ profile => $type });
    $formatter->indentmap->{from} = 0; # don't indent 'FROM'
    # $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 new-line 'ON'

    return $formatter->format($str);
=begin # done by SQL::Abstract::Tree now
    $str =~ s/(FROM|WHERE|ORDER BY|GROUP BY)/\n$1/g;
    $str =~ s/((?<!(OUTER|INNER) )JOIN)/\n\t$1/g;
    my $lh_parens = "\Q("; # p $lh_parens;
    my $rh_parens = "\Q)";
    $str =~ s/(OR $lh_parens)/\n\t$1/g; # p $str;
    # remove blank lines (including just spaces):
    my $query = join "\n", grep { $_ !~ /^\s*$/ } split "\n", $str; # p $query;
    return $query;
=cut
}

# need to call this from app per-request (eg in cgiapp_prerun) if using fastcgi
# in non-external mode - CGI::Fast calls FCGI which re-defines $SIG{__WARN__};
# doesn't cause the same problem when app run as FastCgiExternalServer process
sub ensure_warn_handler_capture { $SIG{__WARN__} = \&_warn_handler; }

sub _warn_handler {
    my $warn = shift || return; # warn $SKIP_LOG_QUERY;

    my $time_now = LIMS::Local::Utils::date_and_time_now;

	unless ($SKIP_LOG_QUERY) { # warn 'here';
        my $divider = '-+-' x 20;
        # $warn =~ s/\s{2}(JOIN)/\n\t$1/g; # line-break & tab JOIN's
        my $msg = sub { # reading pid id & size kills print run (timeout):
    #        sprintf "[%s] %s [%s|%s|%s]\n%s\n", # [time] user [centre, pid ID & size] query:
    #            $time_now, uc $LogArgs->{user}, uc $cfg->{settings}{_centre},
    #            $$, format_number(`ps -p $$ -o size=`+0), $warn;
            sprintf "[%s] %s [%s]\n%s\n/* $divider */\n", # [time] user [centre] query:
                $time_now,
                uc ( $LogArgs->{user} || 'unknown' ),
                uc $cfg->{settings}{_centre},
                format_query($warn, 'console_monochrome'); # monochrome for file
        }; # CORE::warn(&$msg);

        if ( $warn =~ /^(INSERT|UPDATE|DELETE|SELECT|SHOW)/ ) { # warn 'here';
            # deployment db edits go to 'info' level log for archiving:
            if ( $mode eq 'deployment' && $warn =~ /^(INSERT|UPDATE|DELETE)/ ) {
                $dispatcher->log(level => 'info', message => &$msg); # warn 'here';
            }
            $dispatcher->log(level => 'debug', message => &$msg);
        }
	}
#    open my $fh, '>>'.'/tmp/env.txt' or die $!;
#    while( my ($k,$v) = each %ENV ) {
#      print $fh "$k: $v\n";
#    }

    # don't want RDBO::Manager or SQL query statements in apache error.log
    if ( grep { $warn =~ /\A$_/ } @STATEMENTS ) { # p %ENV;
		return 0 unless grep $ENV{$_}, @ENV_OK;
        # dump queries to stdout, unless configured to skip:
		#CORE::warn($warn) unless $SKIP_LOG_QUERY;
        my $format_q = format_query($warn); # coloured for console
		CORE::warn($format_q . "\n") unless $SKIP_LOG_QUERY; # \n suppresses "at line #"
	}
	else { CORE::warn($warn) } # warn everything else

	# dump process size info to stdout if devel server or rdbo_debug:
	if ( $warn !~ /^Making method/ ) { # && grep $ENV{$_}, @ENV_OK ) {
        # my $process_size = `ps -p $$ -o size=`+0;  # moved to 'else' Nov/2016
        if ( $ENV{FAST_CGI} ) {
            my $logfile = $path_to_app . '/logs/processes/' . $$ . '.csv'; # warn $logfile;
            # my $line = join ',', $time_now, $process_size;
            my $line = join ',', $time_now, 'warn:'.$warn; # eg will get here for script errs
            # io($logfile)->append($line, "\n"); # stopped logging Nov/2016
        }
        else {
            my $process_size = `ps -p $$ -o size=`+0;
            CORE::warn sprintf "* process-size=%s\n", $process_size;
		}
	}
}

=begin # FileRotate causes serious performance hit here
    $dispatcher->add(
        Log::Dispatch::FileRotate->new(
            name        => 'query',
            min_level   => 'debug',
            filename    => "$path_to_app_root/logs/sql.txt",
            permissions => 0666,
            mode        => 'append',
            DatePattern => 'yyyy-MM-dd', # every day # or size => 1, # operates in date or size mode
        )
    );
=cut

1;