SQLSession/Action/DoSQL.pm

use strict;
use warnings;

=head1 NAME

SQLSession::Action::DoSQL

=cut

package SQLSession::Action::DoSQL;
use base qw/SQLSession::Action Jifty::Action/;

use SQLSession::Model::DatabaseCollection;
use DBI;
use Time::HiRes qw/time/;

use Data::Dump qw/dump/;

use Jifty::Param::Schema;
use Jifty::Action schema {

        param sql_query =>
                label is 'SQL',
                render as 'textarea',
                ajax validates,
                ajax canonicalizes,
                is mandatory;
        
        param on_database =>
                label is 'Database',
                render as 'Select',
#               available are qw( test foo bar );
                available are defer {
                        my $dbs = SQLSession::Model::DatabaseCollection->new;
                        $dbs->unlimit;
                        [{
                                display_from => 'name',
                                value_from => 'id',
                                collection => $dbs,
                        }];
                };

};

sub sticky_on_success { 1 }
sub sticky_on_failure { 1 }

=head2 validate_sql_query

Can't be empty!

=cut

sub validate_sql_query {
        my $self = shift;
        my $value = shift;

        if ( $value =~ m/^\s+;*\s*$/s ) {
                return $self->validation_error( sql_query => 'You need to type in SQL query' );
        } else {
                return $self->validation_ok('sql_query');
        }
}

sub canonicalize_sql_query {
        my $self = shift;
        my $sql = shift;

        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)(\s+)/sql_uc($1,$2,$3)/egis;

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

        return $sql;
}

=head2 take_action

Execute SQL query on database

=cut

sub take_action {
    my $self = shift;
    
    # Custom action code

        my $on_database = $self->argument_value('on_database') || $self->form_value('on_database');
        warn "on_database: $on_database\n";

        my $db = SQLSession::Model::Database->new;
        $db->load_by_cols( id => $on_database ) ||
                $self->result->error("Can't find database $on_database");

        my $dbh = DBI->connect( $db->dsn, $db->login, $db->passwd ) ||
                $self->result->error("Can't connect to " . $db->dsn . " as " . $db->login . "<br/>" . $DBI::errstr) && return 0;

        $dbh->do("SET client_encoding = UTF8") if ($db->dsn =~ /Pg/);

        my $sql = $self->argument_value('sql_query');

        warn "SQL: $sql\n";

        my $t = time();

        my $sth = $dbh->prepare( $sql ) ||
                $self->result->error( $dbh->errstr() ) && return 0;

        $sth->execute() ||
                $self->result->error( $sth->errstr() ) && return 0;
        
        $self->result->message('Query produced ' . (
                $sth->rows == 0 ?       'no results' :
                $sth->rows == 1 ?       'single row' :
                sprintf("%d rows in %.2fs", $sth->rows, time() - $t)
        )) if ($sth->rows >= 0);

        $self->result->content( sth => $sth );

    return 1;
}

1;

1	dpavlin	5	use strict;
2			use warnings;
3
4			=head1 NAME
5
6			SQLSession::Action::DoSQL
7
8			=cut
9
10			package SQLSession::Action::DoSQL;
11			use base qw/SQLSession::Action Jifty::Action/;
12
13			use SQLSession::Model::DatabaseCollection;
14	dpavlin	7	use DBI;
15	dpavlin	66	use Time::HiRes qw/time/;
16	dpavlin	7
17	dpavlin	5	use Data::Dump qw/dump/;
18
19			use Jifty::Param::Schema;
20			use Jifty::Action schema {
21
22			param sql_query =>
23			label is 'SQL',
24	dpavlin	7	render as 'textarea',
25	dpavlin	35	ajax validates,
26			ajax canonicalizes,
27	dpavlin	28	is mandatory;
28	dpavlin	5
29	dpavlin	84	param on_database =>
30	dpavlin	5	label is 'Database',
31			render as 'Select',
32			# available are qw( test foo bar );
33			available are defer {
34			my $dbs = SQLSession::Model::DatabaseCollection->new;
35			$dbs->unlimit;
36	dpavlin	6	[{
37	dpavlin	5	display_from => 'name',
38	dpavlin	20	value_from => 'id',
39	dpavlin	5	collection => $dbs,
40			}];
41			};
42
43			};
44
45	dpavlin	7	sub sticky_on_success { 1 }
46			sub sticky_on_failure { 1 }
47
48			=head2 validate_sql_query
49
50			Can't be empty!
51
52			=cut
53
54	dpavlin	8	sub validate_sql_query {
55	dpavlin	7	my $self = shift;
56	dpavlin	8	my $value = shift;
57
58			if ( $value =~ m/^\s+;\s$/s ) {
59			return $self->validation_error( sql_query => 'You need to type in SQL query' );
60			} else {
61			return $self->validation_ok('sql_query');
62			}
63	dpavlin	7	}
64
65	dpavlin	13	sub canonicalize_sql_query {
66			my $self = shift;
67			my $sql = shift;
68
69	dpavlin	82	warn "<<<< original SQL:\t$sql";
70	dpavlin	13
71	dpavlin	82	sub sql_uc {
72			my ($prefix,$sql,$suff) = @_;
73			return uc($sql).$suff if (! $prefix \|\| $prefix eq '');
74			return "\n" . uc($sql) . $suff;
75			}
76	dpavlin	13
77	dpavlin	82	$sql =~ s/(\s*)(select\|from\|inner\s+join\|order\s+by\|where\|group\s+by\|having\|limit\|offset)(\s+)/sql_uc($1,$2,$3)/egis;
78	dpavlin	35
79	dpavlin	82	warn ">>>> canonicalize SQL:\n$sql";
80	dpavlin	13
81			return $sql;
82			}
83
84	dpavlin	5	=head2 take_action
85
86	dpavlin	7	Execute SQL query on database
87
88	dpavlin	5	=cut
89
90			sub take_action {
91			my $self = shift;
92
93			# Custom action code
94
95	dpavlin	84	my $on_database = $self->argument_value('on_database') \|\| $self->form_value('on_database');
96			warn "on_database: $on_database\n";
97	dpavlin	5
98	dpavlin	20	my $db = SQLSession::Model::Database->new;
99	dpavlin	84	$db->load_by_cols( id => $on_database ) \|\|
100			$self->result->error("Can't find database $on_database");
101	dpavlin	5
102	dpavlin	7	my $dbh = DBI->connect( $db->dsn, $db->login, $db->passwd ) \|\|
103	dpavlin	11	$self->result->error("Can't connect to " . $db->dsn . " as " . $db->login . "<br/>" . $DBI::errstr) && return 0;
104	dpavlin	7
105	dpavlin	30	$dbh->do("SET client_encoding = UTF8") if ($db->dsn =~ /Pg/);
106	dpavlin	24
107	dpavlin	7	my $sql = $self->argument_value('sql_query');
108
109			warn "SQL: $sql\n";
110
111	dpavlin	66	my $t = time();
112
113	dpavlin	7	my $sth = $dbh->prepare( $sql ) \|\|
114	dpavlin	11	$self->result->error( $dbh->errstr() ) && return 0;
115	dpavlin	7
116			$sth->execute() \|\|
117	dpavlin	11	$self->result->error( $sth->errstr() ) && return 0;
118	dpavlin	7
119	dpavlin	66	$self->result->message('Query produced ' . (
120	dpavlin	7	$sth->rows == 0 ? 'no results' :
121			$sth->rows == 1 ? 'single row' :
122	dpavlin	66	sprintf("%d rows in %.2fs", $sth->rows, time() - $t)
123	dpavlin	7	)) if ($sth->rows >= 0);
124
125	dpavlin	9	$self->result->content( sth => $sth );
126
127	dpavlin	7	return 1;
128	dpavlin	5	}
129
130			1;
131