← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:28 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/SQL/Abstract.pm
Statements Executed18197
Total Time0.0620350000000001 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4390210.032310.03230SQL::Abstract::_anoncopy
187310.015150.05922SQL::Abstract::_recurse_where
534310.002730.00273SQL::Abstract::_convert
537610.002390.00239SQL::Abstract::_debug
386920.002040.00204SQL::Abstract::_sqlcase
180310.001650.00165SQL::Abstract::_bindtype
180210.001620.00257SQL::Abstract::_modlogic
4110.000250.06000SQL::Abstract::select
4110.000180.05943SQL::Abstract::where
4116.6e-56.6e-5SQL::Abstract::_order_by
1113.2e-53.2e-5SQL::Abstract::new
00000SQL::Abstract::AUTOLOAD
00000SQL::Abstract::BEGIN
00000SQL::Abstract::DESTROY
00000SQL::Abstract::_quote
00000SQL::Abstract::_table
00000SQL::Abstract::belch
00000SQL::Abstract::delete
00000SQL::Abstract::generate
00000SQL::Abstract::insert
00000SQL::Abstract::puke
00000SQL::Abstract::update
00000SQL::Abstract::values

LineStmts.Exclusive
Time		Avg.Code
1
2package SQL::Abstract;
3
4=head1 NAME
5
6SQL::Abstract - Generate SQL from Perl data structures
7
8=head1 SYNOPSIS
9
10 use SQL::Abstract;
11
12 my $sql = SQL::Abstract->new;
13
14 my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
15
16 my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
17
18 my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
19
20 my($stmt, @bind) = $sql->delete($table, \%where);
21
22 # Then, use these in your DBI statements
23 my $sth = $dbh->prepare($stmt);
24 $sth->execute(@bind);
25
26 # Just generate the WHERE clause
27 my($stmt, @bind) = $sql->where(\%where, \@order);
28
29 # Return values in the same order, for hashed queries
30 # See PERFORMANCE section for more details
31 my @bind = $sql->values(\%fieldvals);
32
33=head1 DESCRIPTION
34
35This module was inspired by the excellent L<DBIx::Abstract>.
36However, in using that module I found that what I really wanted
37to do was generate SQL, but still retain complete control over my
38statement handles and use the DBI interface. So, I set out to
39create an abstract SQL generation module.
40
41While based on the concepts used by L<DBIx::Abstract>, there are
42several important differences, especially when it comes to WHERE
43clauses. I have modified the concepts used to make the SQL easier
44to generate from Perl data structures and, IMO, more intuitive.
45The underlying idea is for this module to do what you mean, based
46on the data structures you provide it. The big advantage is that
47you don't have to modify your code every time your data changes,
48as this module figures it out.
49
50To begin with, an SQL INSERT is as easy as just specifying a hash
51of C<key=value> pairs:
52
53 my %data = (
54 name => 'Jimbo Bobson',
55 phone => '123-456-7890',
56 address => '42 Sister Lane',
57 city => 'St. Louis',
58 state => 'Louisiana',
59 );
60
61The SQL can then be generated with this:
62
63 my($stmt, @bind) = $sql->insert('people', \%data);
64
65Which would give you something like this:
66
67 $stmt = "INSERT INTO people
68 (address, city, name, phone, state)
69 VALUES (?, ?, ?, ?, ?)";
70 @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
71 '123-456-7890', 'Louisiana');
72
73These are then used directly in your DBI code:
74
75 my $sth = $dbh->prepare($stmt);
76 $sth->execute(@bind);
77
78In addition, you can apply SQL functions to elements of your C<%data>
79by specifying an arrayref for the given hash value. For example, if
80you need to execute the Oracle C<to_date> function on a value, you
81can say something like this:
82
83 my %data = (
84 name => 'Bill',
85 date_entered => ["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
86 );
87
88The first value in the array is the actual SQL. Any other values are
89optional and would be included in the bind values array. This gives
90you:
91
92 my($stmt, @bind) = $sql->insert('people', \%data);
93
94 $stmt = "INSERT INTO people (name, date_entered)
95 VALUES (?, to_date(?,'MM/DD/YYYY'))";
96 @bind = ('Bill', '03/02/2003');
97
98An UPDATE is just as easy, all you change is the name of the function:
99
100 my($stmt, @bind) = $sql->update('people', \%data);
101
102Notice that your C<%data> isn't touched; the module will generate
103the appropriately quirky SQL for you automatically. Usually you'll
104want to specify a WHERE clause for your UPDATE, though, which is
105where handling C<%where> hashes comes in handy...
106
107This module can generate pretty complicated WHERE statements
108easily. For example, simple C<key=value> pairs are taken to mean
109equality, and if you want to see if a field is within a set
110of values, you can use an arrayref. Let's say we wanted to
111SELECT some data based on this criteria:
112
113 my %where = (
114 requestor => 'inna',
115 worker => ['nwiger', 'rcwe', 'sfz'],
116 status => { '!=', 'completed' }
117 );
118
119 my($stmt, @bind) = $sql->select('tickets', '*', \%where);
120
121The above would give you something like this:
122
123 $stmt = "SELECT * FROM tickets WHERE
124 ( requestor = ? ) AND ( status != ? )
125 AND ( worker = ? OR worker = ? OR worker = ? )";
126 @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
127
128Which you could then use in DBI code like so:
129
130 my $sth = $dbh->prepare($stmt);
131 $sth->execute(@bind);
132
133Easy, eh?
134
135=head1 FUNCTIONS
136
137The functions are simple. There's one for each major SQL operation,
138and a constructor you use first. The arguments are specified in a
139similar order to each function (table, then fields, then a where
140clause) to try and simplify things.
141
142=cut
143
14434.0e-51.3e-5use Carp;
# spent 103µs making 1 call to Exporter::import
14530.003140.00105use strict;
# spent 9µs making 1 call to strict::import
146
14711.0e-61.0e-6our $VERSION = '1.22';
14811.0e-61.0e-6our $REVISION = '$Id: Abstract.pm 12 2006-11-30 17:05:24Z nwiger $';
14911.0e-61.0e-6our $AUTOLOAD;
150
151# Fix SQL case, if so requested
152
# spent 2.04ms within SQL::Abstract::_sqlcase which was called 386 times, avg 5µs/call: # 180 times (956µs+0) by SQL::Abstract::_modlogic at line 232, avg 5µs/call # 174 times (852µs+0) by SQL::Abstract::_recurse_where at line 693, avg 5µs/call # 10 times (62µs+0) by SQL::Abstract::_recurse_where at line 610, avg 6µs/call # 8 times (53µs+0) by SQL::Abstract::select at line 538, avg 7µs/call # 3 times (28µs+0) by SQL::Abstract::_recurse_where at line 628, avg 9µs/call # 3 times (27µs+0) by SQL::Abstract::_recurse_where at line 722, avg 9µs/call # 3 times (22µs+0) by SQL::Abstract::where at line 593, avg 7µs/call # 3 times (19µs+0) by SQL::Abstract::_recurse_where at line 733, avg 6µs/call # 2 times (25µs+0) by DBIx::Class::Storage::DBI::BEGIN or DBIC::SQL::Abstract::_recurse_fields at line 146 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm, avg 12µs/call
sub _sqlcase {
1537720.001151.5e-6 my $self = shift;
154 return $self->{case} ? $_[0] : uc($_[0]);
155}
156
157# Anon copies of arrays/hashes
158# Based on deep_copy example by merlyn
159# http://www.stonehenge.com/merlyn/UnixReview/col30.html
160
# spent 32.3ms (32.3+-0ns) within SQL::Abstract::_anoncopy which was called 4390 times, avg 7µs/call: # 4203 times (30.6ms+-30616000ns) by SQL::Abstract::_anoncopy at line 162, avg 0/call # 187 times (1.69ms+30.6ms) by SQL::Abstract::_recurse_where at line 608, avg 173µs/call
sub _anoncopy {
16187800.031893.6e-6 my $orig = shift;
162 return (ref $orig eq 'HASH') ? +{map { $_ => _anoncopy($orig->{$_}) } keys %$orig}
# spent 102ms making 4203 calls to SQL::Abstract::_anoncopy, avg 0/call, max recursion depth 1
163 : (ref $orig eq 'ARRAY') ? [map _anoncopy($_), @$orig]
164 : $orig;
165}
166
167# Debug
168
# spent 2.39ms within SQL::Abstract::_debug which was called 537 times, avg 4µs/call: # 177 times (790µs+0) by SQL::Abstract::_recurse_where at line 686, avg 4µs/call # 174 times (788µs+0) by SQL::Abstract::_recurse_where at line 634, avg 5µs/call # 174 times (734µs+0) by SQL::Abstract::_recurse_where at line 692, avg 4µs/call # 6 times (45µs+0) by SQL::Abstract::_recurse_where at line 654, avg 8µs/call # 3 times (17µs+0) by SQL::Abstract::_recurse_where at line 732, avg 6µs/call # 3 times (16µs+0) by SQL::Abstract::_recurse_where at line 637, avg 5µs/call
sub _debug {
1695370.001072.0e-6 return unless $_[0]->{debug}; shift; # a little faster
170 my $func = (caller(1))[3];
171 warn "[$func] ", @_, "\n";
172}
173
174sub belch (@) {
175 my($func) = (caller(1))[3];
176 carp "[$func] Warning: ", @_;
177}
178
179sub puke (@) {
180 my($func) = (caller(1))[3];
181 croak "[$func] Fatal: ", @_;
182}
183
184# Utility functions
185sub _table {
186 my $self = shift;
187 my $tab = shift;
188 if (ref $tab eq 'ARRAY') {
189 return join ', ', map { $self->_quote($_) } @$tab;
190 } else {
191 return $self->_quote($tab);
192 }
193}
194
195sub _quote {
196 my $self = shift;
197 my $label = shift;
198
199 return $label
200 if $label eq '*';
201
202 return $self->{quote_char} . $label . $self->{quote_char}
203 if !defined $self->{name_sep};
204
205 return join $self->{name_sep},
206 map { $self->{quote_char} . $_ . $self->{quote_char} }
207 split /\Q$self->{name_sep}\E/, $label;
208}
209
210# Conversion, if applicable
211
# spent 2.73ms within SQL::Abstract::_convert which was called 534 times, avg 5µs/call: # 522 times (2.64ms+0) by SQL::Abstract::_recurse_where at line 693, avg 5µs/call # 6 times (44µs+0) by SQL::Abstract::_recurse_where at line 722, avg 7µs/call # 6 times (42µs+0) by SQL::Abstract::_recurse_where at line 733, avg 7µs/call
sub _convert ($) {
21210680.001501.4e-6 my $self = shift;
213 return @_ unless $self->{convert};
214 my $conv = $self->_sqlcase($self->{convert});
215 my @ret = map { $conv.'('.$_.')' } @_;
216 return wantarray ? @ret : $ret[0];
217}
218
219# And bindtype
220
# spent 1.65ms within SQL::Abstract::_bindtype which was called 180 times, avg 9µs/call: # 174 times (1.59ms+0) by SQL::Abstract::_recurse_where at line 702, avg 9µs/call # 3 times (35µs+0) by SQL::Abstract::_recurse_where at line 734, avg 12µs/call # 3 times (25µs+0) by SQL::Abstract::_recurse_where at line 723, avg 8µs/call
sub _bindtype (@) {
2215400.001232.3e-6 my $self = shift;
222 my($col,@val) = @_;
223 return $self->{bindtype} eq 'columns' ? [ @_ ] : @val;
224}
225
226# Modified -logic or -nest
227
# spent 2.57ms (1.62+956µs) within SQL::Abstract::_modlogic which was called 180 times, avg 14µs/call: # 174 times (1.51ms+921µs) by SQL::Abstract::_recurse_where at line 691, avg 14µs/call # 6 times (107µs+35µs) by SQL::Abstract::_recurse_where at line 653, avg 24µs/call
sub _modlogic ($) {
2289000.001461.6e-6 my $self = shift;
229 my $sym = @_ ? lc(shift) : $self->{logic};
230 $sym =~ tr/_/ /;
231 $sym = $self->{logic} if $sym eq 'nest';
232 return $self->_sqlcase($sym); # override join
# spent 956µs making 180 calls to SQL::Abstract::_sqlcase, avg 5µs/call
233}
234
235=head2 new(option => 'value')
236
237The C<new()> function takes a list of options and values, and returns
238a new B<SQL::Abstract> object which can then be used to generate SQL
239through the methods below. The options accepted are:
240
241=over
242
243=item case
244
245If set to 'lower', then SQL will be generated in all lowercase. By
246default SQL is generated in "textbook" case meaning something like:
247
248 SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
249
250=item cmp
251
252This determines what the default comparison operator is. By default
253it is C<=>, meaning that a hash like this:
254
255 %where = (name => 'nwiger', email => 'nate@wiger.org');
256
257Will generate SQL like this:
258
259 WHERE name = 'nwiger' AND email = 'nate@wiger.org'
260
261However, you may want loose comparisons by default, so if you set
262C<cmp> to C<like> you would get SQL such as:
263
264 WHERE name like 'nwiger' AND email like 'nate@wiger.org'
265
266You can also override the comparsion on an individual basis - see
267the huge section on L</"WHERE CLAUSES"> at the bottom.
268
269=item logic
270
271This determines the default logical operator for multiple WHERE
272statements in arrays. By default it is "or", meaning that a WHERE
273array of the form:
274
275 @where = (
276 event_date => {'>=', '2/13/99'},
277 event_date => {'<=', '4/24/03'},
278 );
279
280Will generate SQL like this:
281
282 WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
283
284This is probably not what you want given this query, though (look
285at the dates). To change the "OR" to an "AND", simply specify:
286
287 my $sql = SQL::Abstract->new(logic => 'and');
288
289Which will change the above C<WHERE> to:
290
291 WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
292
293=item convert
294
295This will automatically convert comparisons using the specified SQL
296function for both column and value. This is mostly used with an argument
297of C<upper> or C<lower>, so that the SQL will have the effect of
298case-insensitive "searches". For example, this:
299
300 $sql = SQL::Abstract->new(convert => 'upper');
301 %where = (keywords => 'MaKe iT CAse inSeNSItive');
302
303Will turn out the following SQL:
304
305 WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
306
307The conversion can be C<upper()>, C<lower()>, or any other SQL function
308that can be applied symmetrically to fields (actually B<SQL::Abstract> does
309not validate this option; it will just pass through what you specify verbatim).
310
311=item bindtype
312
313This is a kludge because many databases suck. For example, you can't
314just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
315Instead, you have to use C<bind_param()>:
316
317 $sth->bind_param(1, 'reg data');
318 $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
319
320The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
321which loses track of which field each slot refers to. Fear not.
322
323If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
324Currently, you can specify either C<normal> (default) or C<columns>. If you
325specify C<columns>, you will get an array that looks like this:
326
327 my $sql = SQL::Abstract->new(bindtype => 'columns');
328 my($stmt, @bind) = $sql->insert(...);
329
330 @bind = (
331 [ 'column1', 'value1' ],
332 [ 'column2', 'value2' ],
333 [ 'column3', 'value3' ],
334 );
335
336You can then iterate through this manually, using DBI's C<bind_param()>.
337
338 $sth->prepare($stmt);
339 my $i = 1;
340 for (@bind) {
341 my($col, $data) = @$_;
342 if ($col eq 'details' || $col eq 'comments') {
343 $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
344 } elsif ($col eq 'image') {
345 $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
346 } else {
347 $sth->bind_param($i, $data);
348 }
349 $i++;
350 }
351 $sth->execute; # execute without @bind now
352
353Now, why would you still use B<SQL::Abstract> if you have to do this crap?
354Basically, the advantage is still that you don't have to care which fields
355are or are not included. You could wrap that above C<for> loop in a simple
356sub called C<bind_fields()> or something and reuse it repeatedly. You still
357get a layer of abstraction over manual SQL specification.
358
359=item quote_char
360
361This is the character that a table or column name will be quoted
362with. By default this is an empty string, but you could set it to
363the character C<`>, to generate SQL like this:
364
365 SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
366
367This is useful if you have tables or columns that are reserved words
368in your database's SQL dialect.
369
370=item name_sep
371
372This is the character that separates a table and column name. It is
373necessary to specify this when the C<quote_char> option is selected,
374so that tables and column names can be individually quoted like this:
375
376 SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
377
378=back
379
380=cut
381
382
# spent 32µs within SQL::Abstract::new which was called # once (32µs+0) by DBIC::SQL::Abstract::new or DBIx::Class::Storage::DBI::BEGIN at line 33 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm
sub new {
38392.7e-53.0e-6 my $self = shift;
384 my $class = ref($self) || $self;
385 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
386
387 # choose our case by keeping an option around
388 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
389
390 # override logical operator
391 $opt{logic} = uc $opt{logic} if $opt{logic};
392
393 # how to return bind vars
394 $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
395
396 # default comparison is "=", but can be overridden
397 $opt{cmp} ||= '=';
398
399 # default quotation character around tables/columns
400 $opt{quote_char} ||= '';
401
402 return bless \%opt, $class;
403}
404
405=head2 insert($table, \@values || \%fieldvals)
406
407This is the simplest function. You simply give it a table name
408and either an arrayref of values or hashref of field/value pairs.
409It returns an SQL INSERT statement and a list of bind values.
410
411=cut
412
413sub insert {
414 my $self = shift;
415 my $table = $self->_table(shift);
416 my $data = shift || return;
417
418 my $sql = $self->_sqlcase('insert into') . " $table ";
419 my(@sqlf, @sqlv, @sqlq) = ();
420
421 my $ref = ref $data;
422 if ($ref eq 'HASH') {
423 for my $k (sort keys %$data) {
424 my $v = $data->{$k};
425 my $r = ref $v;
426 # named fields, so must save names in order
427 push @sqlf, $self->_quote($k);
428 if ($r eq 'ARRAY') {
429 # SQL included for values
430 my @val = @$v;
431 push @sqlq, shift @val;
432 push @sqlv, $self->_bindtype($k, @val);
433 } elsif ($r eq 'SCALAR') {
434 # embedded literal SQL
435 push @sqlq, $$v;
436 } else {
437 push @sqlq, '?';
438 push @sqlv, $self->_bindtype($k, $v);
439 }
440 }
441 $sql .= '(' . join(', ', @sqlf) .') '. $self->_sqlcase('values') . ' ('. join(', ', @sqlq) .')';
442 } elsif ($ref eq 'ARRAY') {
443 # just generate values(?,?) part
444 # no names (arrayref) so can't generate bindtype
445 carp "Warning: ",__PACKAGE__,"->insert called with arrayref when bindtype set"
446 if $self->{bindtype} ne 'normal';
447 for my $v (@$data) {
448 my $r = ref $v;
449 if ($r eq 'ARRAY') {
450 my @val = @$v;
451 push @sqlq, shift @val;
452 push @sqlv, @val;
453 } elsif ($r eq 'SCALAR') {
454 # embedded literal SQL
455 push @sqlq, $$v;
456 } else {
457 push @sqlq, '?';
458 push @sqlv, $v;
459 }
460 }
461 $sql .= $self->_sqlcase('values') . ' ('. join(', ', @sqlq) .')';
462 } elsif ($ref eq 'SCALAR') {
463 # literal SQL
464 $sql .= $$data;
465 } else {
466 puke "Unsupported data type specified to \$sql->insert";
467 }
468
469 return wantarray ? ($sql, @sqlv) : $sql;
470}
471
472=head2 update($table, \%fieldvals, \%where)
473
474This takes a table, hashref of field/value pairs, and an optional
475hashref WHERE clause. It returns an SQL UPDATE function and a list
476of bind values.
477
478=cut
479
480sub update {
481 my $self = shift;
482 my $table = $self->_table(shift);
483 my $data = shift || return;
484 my $where = shift;
485
486 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ');
487 my(@sqlf, @sqlv) = ();
488
489 puke "Unsupported data type specified to \$sql->update"
490 unless ref $data eq 'HASH';
491
492 for my $k (sort keys %$data) {
493 my $v = $data->{$k};
494 my $r = ref $v;
495 my $label = $self->_quote($k);
496 if ($r eq 'ARRAY') {
497 # SQL included for values
498 my @bind = @$v;
499 my $sql = shift @bind;
500 push @sqlf, "$label = $sql";
501 push @sqlv, $self->_bindtype($k, @bind);
502 } elsif ($r eq 'SCALAR') {
503 # embedded literal SQL
504 push @sqlf, "$label = $$v";
505 } else {
506 push @sqlf, "$label = ?";
507 push @sqlv, $self->_bindtype($k, $v);
508 }
509 }
510
511 $sql .= join ', ', @sqlf;
512
513 if ($where) {
514 my($wsql, @wval) = $self->where($where);
515 $sql .= $wsql;
516 push @sqlv, @wval;
517 }
518
519 return wantarray ? ($sql, @sqlv) : $sql;
520}
521
522=head2 select($table, \@fields, \%where, \@order)
523
524This takes a table, arrayref of fields (or '*'), optional hashref
525WHERE clause, and optional arrayref order by, and returns the
526corresponding SQL SELECT statement and list of bind values.
527
528=cut
529
530
# spent 60.0ms (245µs+59.8) within SQL::Abstract::select which was called 4 times, avg 15.0ms/call: # 4 times (245µs+59.8ms) by SQL::Abstract::Limit::select at line 170 of /wise/base/static/lib/perl5/site_perl/5.10.0/SQL/Abstract/Limit.pm, avg 15.0ms/call
sub select {
531480.000245.0e-6 my $self = shift;
532 my $table = $self->_table(shift);
# spent 35µs making 4 calls to DBIC::SQL::Abstract::_table, avg 9µs/call
533 my $fields = shift || '*';
534 my $where = shift;
535 my $order = shift;
536
537 my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields : $fields;
538 my $sql = join ' ', $self->_sqlcase('select'), $f, $self->_sqlcase('from'), $table;
# spent 53µs making 8 calls to SQL::Abstract::_sqlcase, avg 7µs/call
539
540 my(@sqlf, @sqlv) = ();
541 my($wsql, @wval) = $self->where($where, $order);
# spent 59.7ms making 4 calls to SQL::Abstract::Limit::where, avg 14.9ms/call
542 $sql .= $wsql;
543 push @sqlv, @wval;
544
545 return wantarray ? ($sql, @sqlv) : $sql;
546}
547
548=head2 delete($table, \%where)
549
550This takes a table name and optional hashref WHERE clause.
551It returns an SQL DELETE statement and list of bind values.
552
553=cut
554
555sub delete {
556 my $self = shift;
557 my $table = $self->_table(shift);
558 my $where = shift;
559
560 my $sql = $self->_sqlcase('delete from') . " $table";
561 my(@sqlf, @sqlv) = ();
562
563 if ($where) {
564 my($wsql, @wval) = $self->where($where);
565 $sql .= $wsql;
566 push @sqlv, @wval;
567 }
568
569 return wantarray ? ($sql, @sqlv) : $sql;
570}
571
572=head2 where(\%where, \@order)
573
574This is used to generate just the WHERE clause. For example,
575if you have an arbitrary data structure and know what the
576rest of your SQL is going to look like, but want an easy way
577to produce a WHERE clause, use this. It returns an SQL WHERE
578clause and list of bind values.
579
580=cut
581
582# Finally, a separate routine just to handle WHERE clauses
583
# spent 59.4ms (184µs+59.2) within SQL::Abstract::where which was called 4 times, avg 14.9ms/call: # 4 times (184µs+59.2ms) by SQL::Abstract::Limit::where at line 230 of /wise/base/static/lib/perl5/site_perl/5.10.0/SQL/Abstract/Limit.pm, avg 14.9ms/call
sub where {
584400.000204.9e-6 my $self = shift;
585 my $where = shift;
586 my $order = shift;
587
588 # Need a separate routine to properly wrap w/ "where"
589 my $sql = '';
590 my @ret = $self->_recurse_where($where);
# spent 59.2ms making 4 calls to SQL::Abstract::_recurse_where, avg 14.8ms/call
591 if (@ret) {
592 my $wh = shift @ret;
593 $sql .= $self->_sqlcase(' where ') . $wh if $wh;
# spent 22µs making 3 calls to SQL::Abstract::_sqlcase, avg 7µs/call
594 }
595
596 # order by?
597 if ($order) {
598 $sql .= $self->_order_by($order);
599 }
600
601 return wantarray ? ($sql, @ret) : $sql;
602}
603
604
605
# spent 59.2ms (15.2+44.1) within SQL::Abstract::_recurse_where which was called 187 times, avg 317µs/call: # 177 times (10.7ms+-10707000ns) by SQL::Abstract::_recurse_where at line 640, avg 0/call # 6 times (3.65ms+-3653000ns) by SQL::Abstract::_recurse_where at line 655, avg 0/call # 4 times (791µs+58.4ms) by SQL::Abstract::where at line 590, avg 14.8ms/call
sub _recurse_where {
60654720.020043.7e-6 local $^W = 0; # really, you've gotta be fucking kidding me
607 my $self = shift;
608 my $where = _anoncopy(shift); # prevent destroying original
# spent 32.3ms making 187 calls to SQL::Abstract::_anoncopy, avg 173µs/call
609 my $ref = ref $where || '';
610 my $join = shift || $self->{logic} ||
# spent 62µs making 10 calls to SQL::Abstract::_sqlcase, avg 6µs/call
611 ($ref eq 'ARRAY' ? $self->_sqlcase('or') : $self->_sqlcase('and'));
612
613 # For assembling SQL fields and values
614 my(@sqlf, @sqlv) = ();
615
616 # If an arrayref, then we join each element
617 if ($ref eq 'ARRAY') {
618 # need to use while() so can shift() for arrays
619 my $subjoin;
620 while (my $el = shift @$where) {
621
622 # skip empty elements, otherwise get invalid trailing AND stuff
623 if (my $ref2 = ref $el) {
624 if ($ref2 eq 'ARRAY') {
625 next unless @$el;
626 } elsif ($ref2 eq 'HASH') {
627 next unless %$el;
628 $subjoin ||= $self->_sqlcase('and');
# spent 28µs making 3 calls to SQL::Abstract::_sqlcase, avg 9µs/call
629 } elsif ($ref2 eq 'SCALAR') {
630 # literal SQL
631 push @sqlf, $$el;
632 next;
633 }
634 $self->_debug("$ref2(*top) means join with $subjoin");
# spent 788µs making 174 calls to SQL::Abstract::_debug, avg 5µs/call
635 } else {
636 # top-level arrayref with scalars, recurse in pairs
637 $self->_debug("NOREF(*top) means join with $subjoin");
# spent 16µs making 3 calls to SQL::Abstract::_debug, avg 5µs/call
638 $el = {$el => shift(@$where)};
639 }
640 my @ret = $self->_recurse_where($el, $subjoin);
# spent 70.0ms making 177 calls to SQL::Abstract::_recurse_where, avg 0/call, max recursion depth 4
641 push @sqlf, shift @ret;
642 push @sqlv, @ret;
643 }
644 }
645 elsif ($ref eq 'HASH') {
646 # Note: during recursion, the last element will always be a hashref,
647 # since it needs to point a column => value. So this be the end.
648 for my $k (sort keys %$where) {
649 my $v = $where->{$k};
650 my $label = $self->_quote($k);
# spent 1.44ms making 186 calls to DBIC::SQL::Abstract::_quote, avg 8µs/call
651 if ($k =~ /^-(\D+)/) {
652 # special nesting, like -and, -or, -nest, so shift over
653 my $subjoin = $self->_modlogic($1);
# spent 142µs making 6 calls to SQL::Abstract::_modlogic, avg 24µs/call
654 $self->_debug("OP(-$1) means special logic ($subjoin), recursing...");
# spent 45µs making 6 calls to SQL::Abstract::_debug, avg 8µs/call
655 my @ret = $self->_recurse_where($v, $subjoin);
# spent 87.4ms making 6 calls to SQL::Abstract::_recurse_where, avg 0/call, max recursion depth 3
656 push @sqlf, shift @ret;
657 push @sqlv, @ret;
658 } elsif (! defined($v)) {
659 # undef = null
660 $self->_debug("UNDEF($k) means IS NULL");
661 push @sqlf, $label . $self->_sqlcase(' is null');
662 } elsif (ref $v eq 'ARRAY') {
663 my @v = @$v;
664
665 # multiple elements: multiple options
666 $self->_debug("ARRAY($k) means multiple elements: [ @v ]");
667
668 # special nesting, like -and, -or, -nest, so shift over
669 my $subjoin = $self->_sqlcase('or');
670 if ($v[0] =~ /^-(\D+)/) {
671 $subjoin = $self->_modlogic($1); # override subjoin
672 $self->_debug("OP(-$1) means special logic ($subjoin), shifting...");
673 shift @v;
674 }
675
676 # map into an array of hashrefs and recurse
677 my @ret = $self->_recurse_where([map { {$k => $_} } @v], $subjoin);
678
679 # push results into our structure
680 push @sqlf, shift @ret;
681 push @sqlv, @ret;
682 } elsif (ref $v eq 'HASH') {
683 # modified operator { '!=', 'completed' }
684 for my $f (sort keys %$v) {
685 my $x = $v->{$f};
686 $self->_debug("HASH($k) means modified operator: { $f }");
# spent 790µs making 177 calls to SQL::Abstract::_debug, avg 4µs/call
687
688 # check for the operator being "IN" or "BETWEEN" or whatever
689 if (ref $x eq 'ARRAY') {
690 if ($f =~ /^-?\s*(not[\s_]+)?(in|between)\s*$/i) {
691 my $u = $self->_modlogic($1 . $2);
# spent 2.43ms making 174 calls to SQL::Abstract::_modlogic, avg 14µs/call
692 $self->_debug("HASH($f => $x) uses special operator: [ $u ]");
# spent 734µs making 174 calls to SQL::Abstract::_debug, avg 4µs/call
693 if ($u =~ /between/i) {
# spent 2.64ms making 522 calls to SQL::Abstract::_convert, avg 5µs/call # spent 852µs making 174 calls to SQL::Abstract::_sqlcase, avg 5µs/call
694 # SQL sucks
695 push @sqlf, join ' ', $self->_convert($label), $u, $self->_convert('?'),
696 $self->_sqlcase('and'), $self->_convert('?');
697 } else {
698 push @sqlf, join ' ', $self->_convert($label), $u, '(',
699 join(', ', map { $self->_convert('?') } @$x),
700 ')';
701 }
702 push @sqlv, $self->_bindtype($k, @$x);
# spent 1.59ms making 174 calls to SQL::Abstract::_bindtype, avg 9µs/call
703 } else {
704 # multiple elements: multiple options
705 $self->_debug("ARRAY($x) means multiple elements: [ @$x ]");
706
707 # map into an array of hashrefs and recurse
708 my @ret = $self->_recurse_where([map { {$k => {$f, $_}} } @$x]);
709
710 # push results into our structure
711 push @sqlf, shift @ret;
712 push @sqlv, @ret;
713 }
714 } elsif (! defined($x)) {
715 # undef = NOT null
716 my $not = ($f eq '!=' || $f eq 'not like') ? ' not' : '';
717 push @sqlf, $label . $self->_sqlcase(" is$not null");
718 } else {
719 # regular ol' value
720 $f =~ s/^-//; # strip leading -like =>
721 $f =~ s/_/ /; # _ => " "
722 push @sqlf, join ' ', $self->_convert($label), $self->_sqlcase($f), $self->_convert('?');
# spent 44µs making 6 calls to SQL::Abstract::_convert, avg 7µs/call # spent 27µs making 3 calls to SQL::Abstract::_sqlcase, avg 9µs/call
723 push @sqlv, $self->_bindtype($k, $x);
# spent 25µs making 3 calls to SQL::Abstract::_bindtype, avg 8µs/call
724 }
725 }
726 } elsif (ref $v eq 'SCALAR') {
727 # literal SQL
728 $self->_debug("SCALAR($k) means literal SQL: $$v");
729 push @sqlf, "$label $$v";
730 } else {
731 # standard key => val
732 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
# spent 17µs making 3 calls to SQL::Abstract::_debug, avg 6µs/call
733 push @sqlf, join ' ', $self->_convert($label), $self->_sqlcase($self->{cmp}), $self->_convert('?');
# spent 42µs making 6 calls to SQL::Abstract::_convert, avg 7µs/call # spent 19µs making 3 calls to SQL::Abstract::_sqlcase, avg 6µs/call
734 push @sqlv, $self->_bindtype($k, $v);
# spent 35µs making 3 calls to SQL::Abstract::_bindtype, avg 12µs/call
735 }
736 }
737 }
738 elsif ($ref eq 'SCALAR') {
739 # literal sql
740 $self->_debug("SCALAR(*top) means literal SQL: $$where");
741 push @sqlf, $$where;
742 }
743 elsif (defined $where) {
744 # literal sql
745 $self->_debug("NOREF(*top) means literal SQL: $where");
746 push @sqlf, $where;
747 }
748
749 # assemble and return sql
750 my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '';
751 return wantarray ? ($wsql, @sqlv) : $wsql;
752}
753
754
# spent 66µs within SQL::Abstract::_order_by which was called 4 times, avg 16µs/call: # 4 times (66µs+0) by DBIC::SQL::Abstract::_order_by or DBIx::Class::Storage::DBI::BEGIN at line 181 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm, avg 16µs/call
sub _order_by {
755204.7e-52.4e-6 my $self = shift;
756 my $ref = ref $_[0];
757
758 my @vals = $ref eq 'ARRAY' ? @{$_[0]} :
759 $ref eq 'SCALAR' ? ${$_[0]} :
760 $ref eq '' ? $_[0] :
761 puke "Unsupported data struct $ref for ORDER BY";
762
763 my $val = join ', ', map { $self->_quote($_) } @vals;
764 return $val ? $self->_sqlcase(' order by')." $val" : '';
765}
766
767=head2 values(\%data)
768
769This just returns the values from the hash C<%data>, in the same
770order that would be returned from any of the other above queries.
771Using this allows you to markedly speed up your queries if you
772are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
773
774=cut
775
776sub values {
777 my $self = shift;
778 my $data = shift || return;
779 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
780 unless ref $data eq 'HASH';
781 return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
782}
783
784=head2 generate($any, 'number', $of, \@data, $struct, \%types)
785
786Warning: This is an experimental method and subject to change.
787
788This returns arbitrarily generated SQL. It's a really basic shortcut.
789It will return two different things, depending on return context:
790
791 my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
792 my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
793
794These would return the following:
795
796 # First calling form
797 $stmt = "CREATE TABLE test (?, ?)";
798 @bind = (field1, field2);
799
800 # Second calling form
801 $stmt_and_val = "CREATE TABLE test (field1, field2)";
802
803Depending on what you're trying to do, it's up to you to choose the correct
804format. In this example, the second form is what you would want.
805
806By the same token:
807
808 $sql->generate('alter session', { nls_date_format => 'MM/YY' });
809
810Might give you:
811
812 ALTER SESSION SET nls_date_format = 'MM/YY'
813
814You get the idea. Strings get their case twiddled, but everything
815else remains verbatim.
816
817=cut
818
819sub generate {
820 my $self = shift;
821
822 my(@sql, @sqlq, @sqlv);
823
824 for (@_) {
825 my $ref = ref $_;
826 if ($ref eq 'HASH') {
827 for my $k (sort keys %$_) {
828 my $v = $_->{$k};
829 my $r = ref $v;
830 my $label = $self->_quote($k);
831 if ($r eq 'ARRAY') {
832 # SQL included for values
833 my @bind = @$v;
834 my $sql = shift @bind;
835 push @sqlq, "$label = $sql";
836 push @sqlv, $self->_bindtype($k, @bind);
837 } elsif ($r eq 'SCALAR') {
838 # embedded literal SQL
839 push @sqlq, "$label = $$v";
840 } else {
841 push @sqlq, "$label = ?";
842 push @sqlv, $self->_bindtype($k, $v);
843 }
844 }
845 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
846 } elsif ($ref eq 'ARRAY') {
847 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
848 for my $v (@$_) {
849 my $r = ref $v;
850 if ($r eq 'ARRAY') {
851 my @val = @$v;
852 push @sqlq, shift @val;
853 push @sqlv, @val;
854 } elsif ($r eq 'SCALAR') {
855 # embedded literal SQL
856 push @sqlq, $$v;
857 } else {
858 push @sqlq, '?';
859 push @sqlv, $v;
860 }
861 }
862 push @sql, '(' . join(', ', @sqlq) . ')';
863 } elsif ($ref eq 'SCALAR') {
864 # literal SQL
865 push @sql, $$_;
866 } else {
867 # strings get case twiddled
868 push @sql, $self->_sqlcase($_);
869 }
870 }
871
872 my $sql = join ' ', @sql;
873
874 # this is pretty tricky
875 # if ask for an array, return ($stmt, @bind)
876 # otherwise, s/?/shift @sqlv/ to put it inline
877 if (wantarray) {
878 return ($sql, @sqlv);
879 } else {
880 1 while $sql =~ s/\?/my $d = shift(@sqlv);
881 ref $d ? $d->[1] : $d/e;
882 return $sql;
883 }
884}
885
886100sub DESTROY { 1 }
887sub AUTOLOAD {
888 # This allows us to check for a local, then _form, attr
889 my $self = shift;
890 my($name) = $AUTOLOAD =~ /.*::(.+)/;
891 return $self->generate($name, @_);
892}
893
89414.0e-64.0e-61;
895
896__END__
897
898=head1 WHERE CLAUSES
899
900This module uses a variation on the idea from L<DBIx::Abstract>. It
901is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
902module is that things in arrays are OR'ed, and things in hashes
903are AND'ed.>
904
905The easiest way to explain is to show lots of examples. After
906each C<%where> hash shown, it is assumed you used:
907
908 my($stmt, @bind) = $sql->where(\%where);
909
910However, note that the C<%where> hash can be used directly in any
911of the other functions as well, as described above.
912
913So, let's get started. To begin, a simple hash:
914
915 my %where = (
916 user => 'nwiger',
917 status => 'completed'
918 );
919
920Is converted to SQL C<key = val> statements:
921
922 $stmt = "WHERE user = ? AND status = ?";
923 @bind = ('nwiger', 'completed');
924
925One common thing I end up doing is having a list of values that
926a field can be in. To do this, simply specify a list inside of
927an arrayref:
928
929 my %where = (
930 user => 'nwiger',
931 status => ['assigned', 'in-progress', 'pending'];
932 );
933
934This simple code will create the following:
935
936 $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
937 @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
938
939If you want to specify a different type of operator for your comparison,
940you can use a hashref for a given column:
941
942 my %where = (
943 user => 'nwiger',
944 status => { '!=', 'completed' }
945 );
946
947Which would generate:
948
949 $stmt = "WHERE user = ? AND status != ?";
950 @bind = ('nwiger', 'completed');
951
952To test against multiple values, just enclose the values in an arrayref:
953
954 status => { '!=', ['assigned', 'in-progress', 'pending'] };
955
956Which would give you:
957
958 "WHERE status != ? OR status != ? OR status != ?"
959
960But, this is probably not what you want in this case (look at it). So
961the hashref can also contain multiple pairs, in which case it is expanded
962into an C<AND> of its elements:
963
964 my %where = (
965 user => 'nwiger',
966 status => { '!=', 'completed', -not_like => 'pending%' }
967 );
968
969 # Or more dynamically, like from a form
970 $where{user} = 'nwiger';
971 $where{status}{'!='} = 'completed';
972 $where{status}{'-not_like'} = 'pending%';
973
974 # Both generate this
975 $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
976 @bind = ('nwiger', 'completed', 'pending%');
977
978To get an OR instead, you can combine it with the arrayref idea:
979
980 my %where => (
981 user => 'nwiger',
982 priority => [ {'=', 2}, {'!=', 1} ]
983 );
984
985Which would generate:
986
987 $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
988 @bind = ('nwiger', '2', '1');
989
990However, there is a subtle trap if you want to say something like
991this (notice the C<AND>):
992
993 WHERE priority != ? AND priority != ?
994
995Because, in Perl you I<can't> do this:
996
997 priority => { '!=', 2, '!=', 1 }
998
999As the second C<!=> key will obliterate the first. The solution
1000is to use the special C<-modifier> form inside an arrayref:
1001
1002 priority => [ -and => {'!=', 2}, {'!=', 1} ]
1003
1004Normally, these would be joined by C<OR>, but the modifier tells it
1005to use C<AND> instead. (Hint: You can use this in conjunction with the
1006C<logic> option to C<new()> in order to change the way your queries
1007work by default.) B<Important:> Note that the C<-modifier> goes
1008B<INSIDE> the arrayref, as an extra first element. This will
1009B<NOT> do what you think it might:
1010
1011 priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
1012
1013Here is a quick list of equivalencies, since there is some overlap:
1014
1015 # Same
1016 status => {'!=', 'completed', 'not like', 'pending%' }
1017 status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
1018
1019 # Same
1020 status => {'=', ['assigned', 'in-progress']}
1021 status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
1022 status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
1023
1024In addition to C<-and> and C<-or>, there is also a special C<-nest>
1025operator which adds an additional set of parens, to create a subquery.
1026For example, to get something like this:
1027
1028 $stmt = WHERE user = ? AND ( workhrs > ? OR geo = ? )
1029 @bind = ('nwiger', '20', 'ASIA');
1030
1031You would do:
1032
1033 my %where = (
1034 user => 'nwiger',
1035 -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
1036 );
1037
1038You can also use the hashref format to compare a list of fields using the
1039C<IN> comparison operator, by specifying the list as an arrayref:
1040
1041 my %where = (
1042 status => 'completed',
1043 reportid => { -in => [567, 2335, 2] }
1044 );
1045
1046Which would generate:
1047
1048 $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
1049 @bind = ('completed', '567', '2335', '2');
1050
1051You can use this same format to use other grouping functions, such
1052as C<BETWEEN>, C<SOME>, and so forth. For example:
1053
1054 my %where = (
1055 user => 'nwiger',
1056 completion_date => {
1057 -not_between => ['2002-10-01', '2003-02-06']
1058 }
1059 );
1060
1061Would give you:
1062
1063 WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
1064
1065So far, we've seen how multiple conditions are joined with a top-level
1066C<AND>. We can change this by putting the different conditions we want in
1067hashes and then putting those hashes in an array. For example:
1068
1069 my @where = (
1070 {
1071 user => 'nwiger',
1072 status => { -like => ['pending%', 'dispatched'] },
1073 },
1074 {
1075 user => 'robot',
1076 status => 'unassigned',
1077 }
1078 );
1079
1080This data structure would create the following:
1081
1082 $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
1083 OR ( user = ? AND status = ? ) )";
1084 @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
1085
1086This can be combined with the C<-nest> operator to properly group
1087SQL statements:
1088
1089 my @where = (
1090 -and => [
1091 user => 'nwiger',
1092 -nest => [
1093 -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
1094 -and => [workhrs => {'<', 50}, geo => 'EURO' ]
1095 ],
1096 ],
1097 );
1098
1099That would yield:
1100
1101 WHERE ( user = ? AND
1102 ( ( workhrs > ? AND geo = ? )
1103 OR ( workhrs < ? AND geo = ? ) ) )
1104
1105Finally, sometimes only literal SQL will do. If you want to include
1106literal SQL verbatim, you can specify it as a scalar reference, namely:
1107
1108 my $inn = 'is Not Null';
1109 my %where = (
1110 priority => { '<', 2 },
1111 requestor => \$inn
1112 );
1113
1114This would create:
1115
1116 $stmt = "WHERE priority < ? AND requestor is Not Null";
1117 @bind = ('2');
1118
1119Note that in this example, you only get one bind parameter back, since
1120the verbatim SQL is passed as part of the statement.
1121
1122Of course, just to prove a point, the above can also be accomplished
1123with this:
1124
1125 my %where = (
1126 priority => { '<', 2 },
1127 requestor => { '!=', undef },
1128 );
1129
1130TMTOWTDI.
1131
1132These pages could go on for a while, since the nesting of the data
1133structures this module can handle are pretty much unlimited (the
1134module implements the C<WHERE> expansion as a recursive function
1135internally). Your best bet is to "play around" with the module a
1136little to see how the data structures behave, and choose the best
1137format for your data based on that.
1138
1139And of course, all the values above will probably be replaced with
1140variables gotten from forms or the command line. After all, if you
1141knew everything ahead of time, you wouldn't have to worry about
1142dynamically-generating SQL and could just hardwire it into your
1143script.
1144
1145=head1 PERFORMANCE
1146
1147Thanks to some benchmarking by Mark Stosberg, it turns out that
1148this module is many orders of magnitude faster than using C<DBIx::Abstract>.
1149I must admit this wasn't an intentional design issue, but it's a
1150byproduct of the fact that you get to control your C<DBI> handles
1151yourself.
1152
1153To maximize performance, use a code snippet like the following:
1154
1155 # prepare a statement handle using the first row
1156 # and then reuse it for the rest of the rows
1157 my($sth, $stmt);
1158 for my $href (@array_of_hashrefs) {
1159 $stmt ||= $sql->insert('table', $href);
1160 $sth ||= $dbh->prepare($stmt);
1161 $sth->execute($sql->values($href));
1162 }
1163
1164The reason this works is because the keys in your C<$href> are sorted
1165internally by B<SQL::Abstract>. Thus, as long as your data retains
1166the same structure, you only have to generate the SQL the first time
1167around. On subsequent queries, simply use the C<values> function provided
1168by this module to return your values in the correct order.
1169
1170=head1 FORMBUILDER
1171
1172If you use my C<CGI::FormBuilder> module at all, you'll hopefully
1173really like this part (I do, at least). Building up a complex query
1174can be as simple as the following:
1175
1176 #!/usr/bin/perl
1177
1178 use CGI::FormBuilder;
1179 use SQL::Abstract;
1180
1181 my $form = CGI::FormBuilder->new(...);
1182 my $sql = SQL::Abstract->new;
1183
1184 if ($form->submitted) {
1185 my $field = $form->field;
1186 my $id = delete $field->{id};
1187 my($stmt, @bind) = $sql->update('table', $field, {id => $id});
1188 }
1189
1190Of course, you would still have to connect using C<DBI> to run the
1191query, but the point is that if you make your form look like your
1192table, the actual query script can be extremely simplistic.
1193
1194If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
1195a fast interface to returning and formatting data. I frequently
1196use these three modules together to write complex database query
1197apps in under 50 lines.
1198
1199=head1 NOTES
1200
1201There is not (yet) any explicit support for SQL compound logic
1202statements like "AND NOT". Instead, just do the de Morgan's
1203law transformations yourself. For example, this:
1204
1205 "lname LIKE '%son%' AND NOT ( age < 10 OR age > 20 )"
1206
1207Becomes:
1208
1209 "lname LIKE '%son%' AND ( age >= 10 AND age <= 20 )"
1210
1211With the corresponding C<%where> hash:
1212
1213 %where = (
1214 lname => {like => '%son%'},
1215 age => [-and => {'>=', 10}, {'<=', 20}],
1216 );
1217
1218Again, remember that the C<-and> goes I<inside> the arrayref.
1219
1220=head1 ACKNOWLEDGEMENTS
1221
1222There are a number of individuals that have really helped out with
1223this module. Unfortunately, most of them submitted bugs via CPAN
1224so I have no idea who they are! But the people I do know are:
1225
1226 Mark Stosberg (benchmarking)
1227 Chas Owens (initial "IN" operator support)
1228 Philip Collins (per-field SQL functions)
1229 Eric Kolve (hashref "AND" support)
1230 Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
1231 Dan Kubb (support for "quote_char" and "name_sep")
1232 Matt Trout (DBIx::Class support)
1233
1234Thanks!
1235
1236=head1 BUGS
1237
1238If found, please DO NOT submit anything via C<rt.cpan.org> - that
1239just causes me a ton of work. Email me a patch (or script demonstrating
1240the problem) to the below address, and include the VERSION you're using.
1241
1242=head1 SEE ALSO
1243
1244L<DBIx::Abstract>, L<DBI|DBI>, L<CGI::FormBuilder>, L<HTML::QuickTable>
1245
1246=head1 AUTHOR
1247
1248Copyright (c) 2001-2006 Nathan Wiger <nwiger@cpan.org>. All Rights Reserved.
1249
1250For support, your best bet is to try the C<DBIx::Class> users mailing list.
1251While not an official support venue, C<DBIx::Class> makes heavy use of
1252C<SQL::Abstract>, and as such list members there are very familiar with
1253how to create queries.
1254
1255This module is free software; you may copy this under the terms of
1256the GNU General Public License, or the Artistic License, copies of
1257which should have accompanied your Perl kit.
1258
1259=cut
1260

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.