File Coverage

blib/lib/Mojolicious/Plugin/QuickPg.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::QuickPg;
2 1     1   13431 use Mojo::Base 'Mojolicious::Plugin';
  1         6802  
  1         4  
3            
4 1     1   1068 use Mojo::Pg;
  0            
  0            
5             use Carp;
6            
7             our $VERSION = '1.4';
8             our $Debug = 0;
9             has pg => sub { +{} };
10            
11             sub register {
12             my ($plugin, $app, $conf) = @_;
13             my $version = undef;
14             croak qq{DSN is empty! See perldoc...\n} unless $conf->{dsn};
15            
16             $plugin->pg(Mojo::Pg->new($conf->{dsn}));
17             $Debug = $conf->{debug};
18            
19             eval {
20             $version = $plugin->pg->db->query('select version()')->hash;
21             };
22             croak qq{Invalid dsn: $@ \n} if $@;
23             $app->log->info($version->{version}) if ($conf->{debug});
24            
25             $app->helper( qselect => sub {$plugin->_quick_select(@_)});
26             $app->helper( qinsert => sub {$plugin->_quick_insert(@_)});
27             $app->helper( qupdate => sub {$plugin->_quick_update(@_)});
28             $app->helper( qdelete => sub {$plugin->_quick_delete(@_)});
29             $app->helper( qcount => sub {$plugin->_quick_count(@_)});
30             $app->helper( qcustom => sub {
31             my ($self, $sql, @params) = @_;
32             eval {
33             local $SIG{__WARN__} = sub {};
34             return $plugin->pg->db->query($sql,@params);
35             };
36            
37             });
38             $app->helper( qerror => sub { return $@ });
39             }
40            
41             sub _quick_insert {
42             my ($plugin, $self, $table_name, $data) = @_;
43             return $plugin->_quick_query('INSERT', $table_name, $data);
44             }
45            
46             #
47             sub _quick_update {
48             my ($plugin, $self, $table_name, $where, $data) = @_;
49             return $plugin->_quick_query('UPDATE', $table_name, $data, $where);
50             }
51             #
52             #
53             sub _quick_delete {
54             my ($plugin, $self, $table_name, $where) = @_;
55             return $plugin->_quick_query('DELETE', $table_name, undef, $where);
56             }
57            
58             sub _quick_select {
59             my ($plugin, $self, $table_name, $where, $opts) = @_;
60             $where = $where || {};
61             return $plugin->_quick_query('SELECT', $table_name, $opts, $where);
62             }
63            
64            
65             sub _quick_count {
66             my ($plugin, $self, $table_name, $where) = @_;
67             $where = $where || {};
68             my $opts = {}; #Options are irrelevant for a count.
69             return $plugin->_quick_query('COUNT', $table_name, $opts, $where);
70             }
71            
72             #############
73             sub _quick_query {
74             my ($self, $type, $table_name, $data, $where) = @_;
75             # Basic sanity checks first...
76             if ($type !~ m{^ (SELECT|INSERT|UPDATE|DELETE|COUNT) $}x) {
77             carp "Unrecognised query type $type!";
78             return;
79             }
80             if (!$table_name || ref $table_name) {
81             carp "Expected table name as a straight scalar";
82             return;
83             }
84             if (($type eq 'INSERT' || $type eq 'UPDATE')
85             && (!$data || ref $data ne 'HASH'))
86             {
87             carp "Expected a hashref of changes";
88             return;
89             }
90             if (($type =~ m{^ (SELECT|UPDATE|DELETE|COUNT) $}x)
91             && (!$where)) {
92             carp "Expected where conditions";
93             return;
94             }
95            
96             my ($sql, @bind_params) = $self->_generate_sql(
97             $type, $table_name, $data, $where
98             );
99             say $sql if $Debug;
100            
101             if ($type eq 'SELECT') {
102             return $self->pg->db->query($sql, @bind_params)->hash unless wantarray;
103             return $self->pg->db->query($sql, @bind_params)->hashes->to_array;
104             } elsif ($type eq 'COUNT') {
105             my $row = $self->pg->db->query($sql, @bind_params)->hash;
106             return $row->{count};
107             } else {
108             # INSERT (default field name = id)
109             if ($type eq 'INSERT') {
110             # get primary key from table
111             my $PK = 'id'; # default PK column is 'id'
112             my $pkey = $self->pg->db->query(qq{SELECT a.attname FROM pg_index i JOIN pg_attribute a ON a.attrelid = i.indrelid
113             AND a.attnum = ANY(i.indkey) WHERE i.indrelid = '$table_name'::regclass AND i.indisprimary
114             ORDER BY a.attnum DESC});
115             # if id exists in PKeys get it, else - get last elem
116             while (my $next = $pkey->hash) {
117             if ( $next->{attname} eq 'id' ) {
118             $PK = $next->{attname};
119             # Note that "finish" needs to be called if you are not fetching all the possible rows
120             $pkey->finish;
121             last;
122             }
123             else {
124             $PK = $next->{attname};
125             }
126             }
127            
128             $sql .= ' returning ' . $PK;
129            
130             eval {
131             return $self->pg->db->query($sql, @bind_params)->hash->{$PK};
132             };
133             } else {
134             # delete/update
135             eval {
136             return $self->pg->db->query($sql, @bind_params)->rows;
137             };
138             }
139            
140             }
141             }
142            
143             sub _generate_sql {
144             my ($self, $type, $table_name, $data, $where) = @_;
145            
146             my $which_cols = '*';
147             my $opts = $type eq 'SELECT' && $data ? $data : {};
148             if ($opts->{columns}) {
149             my @cols = (ref $opts->{columns})
150             ? @{ $opts->{columns} }
151             : $opts->{columns} ;
152             $which_cols = join(',', map { $self->_quote_identifier($_) } @cols);
153             }
154            
155             $table_name = $self->_quote_identifier($table_name);
156             my @bind_params;
157            
158             my $sql = {
159             SELECT => "SELECT $which_cols FROM $table_name",
160             INSERT => "INSERT INTO $table_name ",
161             UPDATE => "UPDATE $table_name SET ",
162             DELETE => "DELETE FROM $table_name ",
163             COUNT => "SELECT COUNT(*) FROM $table_name",
164             }->{$type};
165            
166             if ($type eq 'INSERT') {
167             my (@keys, @values);
168             for my $key (sort keys %$data) {
169             my $value = $data->{$key};
170             push @keys, $self->_quote_identifier($key);
171             if (ref $value eq 'SCALAR') {
172             # If it's a scalarref it goes in the SQL as it is; this is a
173             # potential SQL injection risk, but is documented as such - it
174             # allows the user to include arbitrary SQL, at their own risk.
175             push @values, $$value;
176             } else {
177             push @values, "?";
178             push @bind_params, $value;
179             }
180             }
181            
182             $sql .= sprintf "(%s) VALUES (%s)",
183             join(',', @keys), join(',', @values);
184             }
185            
186             if ($type eq 'UPDATE') {
187             my @sql;
188             for (sort keys %$data) {
189             push @sql, $self->_quote_identifier($_) . '=' .
190             (ref $data->{$_} eq 'SCALAR' ? ${$data->{$_}} : "?");
191             push @bind_params, $data->{$_} if (ref $data->{$_} ne 'SCALAR');
192             }
193             $sql .= join ',', @sql;
194             }
195            
196             if ($type eq 'UPDATE' || $type eq 'DELETE' || $type eq 'SELECT' || $type eq 'COUNT')
197             {
198             if ($where && !ref $where) {
199             $sql .= " WHERE " . $where;
200             } elsif ( ref $where eq 'HASH' ) {
201             my @stmts;
202             foreach my $k ( sort keys %$where ) {
203             my $v = $where->{$k};
204             if ( ref $v eq 'HASH' ) {
205             my $not = delete $v->{'not'};
206             while (my($op,$value) = each %$v ) {
207             my ($cond, $add_bind_param)
208             = $self->_get_where_sql($op, $not, $value);
209             push @stmts, $self->_quote_identifier($k) . $cond;
210             push @bind_params, $v->{$op} if $add_bind_param;
211             }
212             } else {
213             my $clause .= $self->_quote_identifier($k);
214             if ( ! defined $v ) {
215             $clause .= ' IS NULL';
216             }
217             elsif ( ! ref $v ) {
218             $clause .= '=?';
219             push @bind_params, $v;
220             }
221             elsif ( ref $v eq 'ARRAY' ) {
222             $clause .= ' IN (' . (join ',', map { '?' } @$v) . ')';
223             push @bind_params, @$v;
224             }
225             push @stmts, $clause;
226             }
227             }
228             $sql .= " WHERE " . join " AND ", @stmts if keys %$where;
229             } elsif (ref $where) {
230             carp "Can't handle ref " . ref $where . " for where";
231             return;
232             }
233             }
234            
235             # Add an ORDER BY clause, if we want to:
236             if (exists $opts->{order_by} and defined $opts->{order_by}) {
237             $sql .= ' ' . $self->_build_order_by_clause($opts->{order_by});
238             }
239            
240            
241             # Add a LIMIT clause if we want to:
242             if (exists $opts->{limit} and defined $opts->{limit}) {
243             my $limit = $opts->{limit};
244             $limit =~ s/\s+//g;
245             # Check the limit clause is sane - just a number, or two numbers with a
246             # comma between (if using offset,limit )
247             if ($limit =~ m{ ^ \d+ (?: , \d+)? $ }x) {
248             # Checked for sanity above so safe to interpolate
249             $sql .= " LIMIT $limit";
250             } else {
251             die "Invalid LIMIT param $opts->{limit} !";
252             }
253             } elsif ($type eq 'SELECT' && !wantarray) {
254             # We're only returning one row in scalar context, so don't ask for any
255             # more than that
256             $sql .= " LIMIT 1";
257             }
258            
259             if (exists $opts->{offset} and defined $opts->{offset}) {
260             my $offset = $opts->{offset};
261             $offset =~ s/\s+//g;
262             if ($offset =~ /^\d+$/) {
263             $sql .= " OFFSET $offset";
264             } else {
265             die "Invalid OFFSET param $opts->{offset} !";
266             }
267             }
268             return ($sql, @bind_params);
269             }
270            
271             sub _get_where_sql {
272             my ($self, $op, $not, $value) = @_;
273            
274             $op = lc $op;
275            
276             # "IS" needs special-casing, as it will be either "IS NULL" or "IS NOT NULL"
277             # - there's no need to return a bind param for that.
278             if ($op eq 'is') {
279             return $not ? 'IS NOT NULL' : 'IS NULL';
280             }
281            
282             my %st = (
283             'like' => ' LIKE ?',
284             'is' => ' IS ?',
285             'ge' => ' >= ?',
286             'gt' => ' > ?',
287             'le' => ' <= ?',
288             'lt' => ' < ?',
289             'eq' => ' = ?',
290             'ne' => ' != ?',
291             );
292            
293             # Return the appropriate SQL, and indicate that the value should be added to
294             # the bind params
295             return (($not ? ' NOT' . $st{$op} : $st{$op}), 1);
296             }
297            
298             # Given either a column name, or a hashref of e.g. { asc => 'colname' },
299             # or an arrayref of either, construct an ORDER BY clause (quoting col names)
300             # e.g.:
301             # 'foo' => ORDER BY foo
302             # { asc => 'foo' } => ORDER BY foo ASC
303             # ['foo', 'bar'] => ORDER BY foo, bar
304             # [ { asc => 'foo' }, { desc => 'bar' } ]
305             # => 'ORDER BY foo ASC, bar DESC
306             sub _build_order_by_clause {
307             my ($self, $in) = @_;
308            
309             # Input could be a straight scalar, or a hashref, or an arrayref of either
310             # straight scalars or hashrefs. Turn a straight scalar into an arrayref to
311             # avoid repeating ourselves.
312             $in = [ $in ] unless ref $in eq 'ARRAY';
313            
314             # Now, for each of the fields given, add them to the clause
315             my @sort_fields;
316             for my $field (@$in) {
317             if (!ref $field) {
318             push @sort_fields, $self->_quote_identifier($field);
319             } elsif (ref $field eq 'HASH') {
320             my ($order, $name) = %$field;
321             $order = uc $order;
322             if ($order ne 'ASC' && $order ne 'DESC') {
323             die "Invalid sort order $order used in order_by option!";
324             }
325             # $order has been checked to be 'ASC' or 'DESC' above, so safe to
326             # interpolate
327             push @sort_fields, $self->_quote_identifier($name) . " $order";
328             }
329             }
330            
331             return "ORDER BY " . join ', ', @sort_fields;
332             }
333            
334             # A wrapper around DBI's quote_identifier which first splits on ".", so that
335             # e.g. database.table gets quoted as `database`.`table`, not `database.table`
336             sub _quote_identifier {
337             my ($self, $identifier) = @_;
338             return join '.', map {
339             qq{$_}
340             } split /\./, $identifier;
341             }
342            
343             1;
344             __END__