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) { # p $sql; p @bind; # duplicate of Local::Utils dump_query  
    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;    
    if ($sql =~ /^SELECT/) {
        # 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;
        # re-build query string:
        $sql = qq!SELECT\n  $cols\nFROM\n  $remainder!;
        $sql =~ s/\b(WHERE|ORDER BY|GROUP BY|HAVING|LIMIT|OFFSET)\b/\n$1/g;
        $sql .= ';' unless $sql =~ /;$/; # p $sql;

        my $lh_parens = "\Q(";
        my $rh_parens = "\Q)";
        $sql =~ s/(OR $lh_parens)/\n\t$1/g;
        # $sql =~ s/($lh_parens|$rh_parens)/\n\t$1/g; # also works OK
        # $sql =~ s/(OR|AND)/\n\t$1/g; # doesn't really work
    }
    elsif ($sql =~ /^INSERT/) {
        $sql =~ s/(VALUES|ON CONFLICT)/\n  $1/g; # new-lines before VALUES or ON CONFLICT
        $sql =~ s{(?<!ON CONFLICT)\(}{\(\n    }g; # new-line after ')' unless after ON CONFLICT
        $sql =~ s/(,|UPDATE SET)/$1\n    /g; # new-line after comma or 'UPDATE SET'
    }

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

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

 1;