lib/SQLSession/Utils.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 02/16/07 21:42:21 CET

use strict;
use warnings;

package SQLSession::Utils;
use Exporter qw/import/;
our @EXPORT_OK = qw(
        reformat_sql
);

=head2 reformat_sql

Pretty-print (but still plain ASCII) SQL statement;

  print $self->reformat_sql( $sql );

=cut

sub reformat_sql {
        my $self = shift;

        my $sql = shift || return;

        warn "<<<< original SQL:\t$sql";

        sub sql_uc {
                my ($prefix,$sql,$suff) = @_;
                return uc($sql).$suff if (! $prefix || $prefix eq '');
                return "\n" . uc($sql) . $suff;
        }

        $sql =~ s/(\s*)(select|from|inner\s+join|order\s+by|where|group\s+by|having|limit|offset|union)(\s+)/sql_uc($1,$2,$3)/egis;

        warn ">>>> canonicalize SQL:\n$sql";

        return $sql;
}

1;
1	dpavlin	99	# Dobrica Pavlinusic, <dpavlin@rot13.org> 02/16/07 21:42:21 CET
2
3			use strict;
4			use warnings;
5
6			package SQLSession::Utils;
7			use Exporter qw/import/;
8			our @EXPORT_OK = qw(
9			reformat_sql
10			);
11
12			=head2 reformat_sql
13
14			Pretty-print (but still plain ASCII) SQL statement;
15
16			print $self->reformat_sql( $sql );
17
18			=cut
19
20			sub reformat_sql {
21			my $self = shift;
22
23			my $sql = shift \|\| return;
24
25			warn "<<<< original SQL:\t$sql";
26
27			sub sql_uc {
28			my ($prefix,$sql,$suff) = @_;
29			return uc($sql).$suff if (! $prefix \|\| $prefix eq '');
30			return "\n" . uc($sql) . $suff;
31			}
32
33	dpavlin	109	$sql =~ s/(\s*)(select\|from\|inner\s+join\|order\s+by\|where\|group\s+by\|having\|limit\|offset\|union)(\s+)/sql_uc($1,$2,$3)/egis;
34	dpavlin	99
35			warn ">>>> canonicalize SQL:\n$sql";
36
37			return $sql;
38			}
39
40			1;