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 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');
        }
}

use SQL::ReservedWords;

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

        my @words = SQL::ReservedWords->words;

        my $w = join('|', @words);

        $w .= '|limit|offset';  # fixup

        warn "original SQL:\t$sql";

        $sql =~ s/([\b^'])($w)\1/uc($2)/egis;

        warn "canonicalize SQL:\t$sql";

        return $sql;
}

=head2 take_action

Execute SQL query on database

=cut

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

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

        my $db = SQLSession::Model::Database->new;
        $db->load_by_cols( id => $database ) ||
                $self->result->error("Can't find database $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	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	use DBI;
15	use Time::HiRes qw/time/;
16
17	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	render as 'textarea',
25	ajax validates,
26	ajax canonicalizes,
27	is mandatory;
28
29	param database =>
30	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	[{
37	display_from => 'name',
38	value_from => 'id',
39	collection => $dbs,
40	}];
41	};
42
43	};
44
45	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	sub validate_sql_query {
55	my $self = shift;
56	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	}
64
65	use SQL::ReservedWords;
66
67	sub canonicalize_sql_query {
68	my $self = shift;
69	my $sql = shift;
70
71	my @words = SQL::ReservedWords->words;
72
73	my $w = join('\|', @words);
74
75	$w .= '\|limit\|offset'; # fixup
76
77	warn "original SQL:\t$sql";
78
79	$sql =~ s/([\b^'])($w)\1/uc($2)/egis;
80
81	warn "canonicalize SQL:\t$sql";
82
83	return $sql;
84	}
85
86	=head2 take_action
87
88	Execute SQL query on database
89
90	=cut
91
92	sub take_action {
93	my $self = shift;
94
95	# Custom action code
96
97	my $database = $self->argument_value('database') \|\| $self->form_value('database');
98	warn "database: $database\n";
99
100	my $db = SQLSession::Model::Database->new;
101	$db->load_by_cols( id => $database ) \|\|
102	$self->result->error("Can't find database $database");
103
104	my $dbh = DBI->connect( $db->dsn, $db->login, $db->passwd ) \|\|
105	$self->result->error("Can't connect to " . $db->dsn . " as " . $db->login . "<br/>" . $DBI::errstr) && return 0;
106
107	$dbh->do("SET client_encoding = UTF8") if ($db->dsn =~ /Pg/);
108
109	my $sql = $self->argument_value('sql_query');
110
111	warn "SQL: $sql\n";
112
113	my $t = time();
114
115	my $sth = $dbh->prepare( $sql ) \|\|
116	$self->result->error( $dbh->errstr() ) && return 0;
117
118	$sth->execute() \|\|
119	$self->result->error( $sth->errstr() ) && return 0;
120
121	$self->result->message('Query produced ' . (
122	$sth->rows == 0 ? 'no results' :
123	$sth->rows == 1 ? 'single row' :
124	sprintf("%d rows in %.2fs", $sth->rows, time() - $t)
125	)) if ($sth->rows >= 0);
126
127	$self->result->content( sth => $sth );
128
129	return 1;
130	}
131
132	1;
133