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;