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{(?cyan; # eg color($var)->foreground->background say STDERR $divider; } 1;