RSS Git Download  Clone
Raw Blame History
use App::Class; # Import::Into

#===============================================================================
class App::DBIx :isa(DBIx::Simple);
#===============================================================================

use Term::ANSIColor::Simple;
use App::DB::Result; # cannot use its functions !!!!
use Data::Printer;

method query ($str, @bind) { # inherits from parent, dumps query to console if required
    $self->dump_query($str, @bind) if $ENV{SQL_TRACE}; # set at command-line, or in App::DB
    # continue on its original way:
    $self->SUPER::query($str, @bind);
}

method dump_query ($sql, @bind) { # duplicate of Local::Query::logger
    for my $val (@bind) { # replace each '?' with next element of array:
        $val = $self->SUPER::dbh->quote($val) # quote anything other than numbers
        # $val = qq!"$val"! # quote anything other than numbers
            unless Scalar::Util::looks_like_number($val); # say $val;
        $sql =~ s/\Q?/$val/;
    }

=begin
    $sql =~ s/(FROM|WHERE|ORDER BY|GROUP BY)/\n$1/g;
    $sql =~ s/(LEFT OUTER|INNER)/\n\t$1/g;
    $sql =~ s/(\sAND\s)/\n\t$1/g;
=cut
    # replace all white-space (spaces, tabs, new-lines) with single space:
    $sql =~ s/\s+/ /g; # p $sql;
    # all queries have a SELECT ... FROM ...
    my ($cols, $remainder) = $sql =~ /SELECT (.*) FROM (.*)/;  # p $cols;
    # new-lines after comma in SELECT statement, unless inside brackets; doesn't
    # work for brackets-within-brackets eg LEFT(ref.name, .... LOCATE(' ', ....))
    $cols =~ s/(\,(?!\s?\?|[^(]+\)))(?!\n)/$1\n /g;      # p $cols;
    $remainder =~ s/(LEFT OUTER|INNER|\sAND\s)/\n  $1/g; # p $from;
    # build new query string:
    my $str = qq!SELECT\n  $cols\nFROM\n  $remainder!;
    $str =~ s/\b(WHERE|ORDER BY|GROUP BY|HAVING|LIMIT|OFFSET)\b/\n$1/g;
    $str .= ';' unless $str =~ /;$/; # p $str;

    my $lh_parens = "\Q(";
    my $rh_parens = "\Q)";
    $str =~ s/(OR $lh_parens)/\n\t$1/g;
    # $str =~ s/($lh_parens|$rh_parens)/\n\t$1/g; # also works OK
    # $str =~ s/(OR|AND)/\n\t$1/g; # doesn't really work

    my $divider = '#' . '-' x 80 ;

	say STDERR $divider;
    say STDERR color($str)->cyan; # eg color($var)->foreground->background
    say STDERR $divider;
 }

 1;