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

        warn "original SQL:\t$sql";

        $sql =~ s/\b($w)\b/uc($1)/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");

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

        warn "SQL: $sql\n";

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