File Coverage

blib/lib/Rose/DB/Object/QueryBuilder.pm
Criterion Covered Total %
statement 27 492 5.4
branch 0 474 0.0
condition 1 231 0.4
subroutine 9 14 64.2
pod 2 2 100.0
total 39 1213 3.2


line stmt bran cond sub pod time code
1             package Rose::DB::Object::QueryBuilder;
2              
3 62     62   874009 use strict;
  62         153  
  62         1836  
4              
5 62     62   355 use Carp();
  62         151  
  62         1245  
6              
7 62     62   1250 use Rose::DB::Object::Constants qw(STATE_SAVING);
  62         178  
  62         23339  
8              
9             require Exporter;
10             our @ISA = qw(Exporter);
11              
12             our @EXPORT_OK = qw(build_select build_where_clause);
13              
14             our $VERSION = '0.789';
15              
16             our $Debug = 0;
17              
18             our %Op_Map =
19             (
20             similar => 'SIMILAR TO',
21             match => '~',
22             imatch => '~*',
23             regex => 'REGEXP',
24             regexp => 'REGEXP',
25             like => 'LIKE',
26             ilike => 'ILIKE',
27             rlike => 'RLIKE',
28             between => '%COLUMN% BETWEEN ? AND ?',
29             gt_lt => '(%COLUMN% > ? AND %COLUMN% < ?)',
30             gt_le => '(%COLUMN% > ? AND %COLUMN% <= ?)',
31             ge_lt => '(%COLUMN% >= ? AND %COLUMN% < ?)',
32             ge_le => '(%COLUMN% >= ? AND %COLUMN% <= ?)',
33             is => 'IS',
34             is_not => 'IS NOT',
35             lt => '<',
36             le => '<=',
37             ge => '>=',
38             gt => '>',
39             ne => '<>',
40             eq => '=',
41             '&' => '&',
42             '' => '=',
43             sql => '=',
44             in_set => 'ANY IN SET',
45             any_in_set => 'ANY IN SET',
46             all_in_set => 'ALL IN SET',
47             in_array => 'ANY IN ARRAY',
48             any_in_array => 'ANY IN ARRAY',
49             all_in_array => 'ALL IN ARRAY',
50              
51             # ltree operators - added by Rick Apichairuk 2009.02.02
52             #
53             # <,>,<=,>=,=, <>
54             # - have their usual meanings. Comparison is doing in the order
55             # of direct tree traversing, children of a node are sorted
56             # lexicographic.
57             # ltree @> ltree
58             # - returns TRUE if left argument is an ancestor of right
59             # argument (or equal).
60             # ltree <@ ltree
61             # - returns TRUE if left argument is a descendant of right
62             # argument (or equal).
63             # ltree ~ lquery, lquery ~ ltree
64             # - returns TRUE if node represented by ltree satisfies lquery.
65             # ltree ? lquery[], lquery ? ltree[]
66             # - returns TRUE if node represented by ltree satisfies at least
67             # one lquery from array.
68             # ltree @ ltxtquery, ltxtquery @ ltree
69             # - return TRUE if node represented by ltree satisfies ltxtquery.
70             # ltree || ltree, ltree || text, text || ltree
71             # - return concatenated ltree.
72             ltree_ancestor => '@>',
73             ltree_descendant => '<@',
74             ltree_query => '~',
75             ltree_ltxtquery => '@',
76             ltree_concat => '||',
77             );
78              
79             our %Template_Op = map { $Op_Map{$_} => 1 } qw(between gt_lt gt_le ge_lt ge_le);
80              
81             @Op_Map{map { $_ . '_sql' } keys %Op_Map} = values(%Op_Map);
82              
83             our %Op_Wantarray = map { $_ => 2 } map { $_, "${_}_sql" } qw(between gt_lt gt_le ge_lt ge_le);
84              
85             our %Op_Arg_PassThru = map { $_ => 1 }
86             qw(similar match imatch regex regexp regexp_like like ilike rlike
87             in_set any_in_set all_in_set in_array any_in_array all_in_array);
88              
89 62     62   262 BEGIN { local $@; eval { require DBI::Const::GetInfoType }; }
  62         192  
  62         30323  
90 62   50 62   381007 use constant SQL_DBMS_VER => $DBI::Const::GetInfoType::GetInfoType{'SQL_DBMS_VER'} || 18;
  62         149  
  62         45827  
91              
92 0     0 1   sub build_where_clause { build_select(@_, where_only => 1) }
93              
94             sub build_select
95             {
96 0     0 1   my(%args) = @_;
97              
98 0           my $dbh = $args{'dbh'};
99 0   0       my $tables = $args{'tables'} || Carp::croak "Missing 'tables' argument";
100 0   0       my $tables_sql = $args{'tables_sql'} || $tables;
101 0   0       my $logic = delete $args{'logic'} || 'AND';
102 0           my $columns = $args{'columns'};
103 0   0       my $all_columns = $args{'all_columns'} || {};
104 0   0       my $query_arg = delete $args{'query'} || delete $args{'where'};
105 0           my $sort_by = delete $args{'sort_by'};
106 0           my $group_by = delete $args{'group_by'};
107 0           my $limit_suffix = delete $args{'limit_suffix'};
108 0   0       my $limit_prefix = delete $args{'limit_prefix'} || '';
109 0           my $lock = delete $args{'lock'};
110 0 0         my $distinct = delete $args{'distinct'} ? 'DISTINCT ' : '';
111 0           my $select = $args{'select'};
112 0           my $where_only = delete $args{'where_only'};
113 0           my $clauses_arg = delete $args{'clauses'};
114 0 0         my $pretty = exists $args{'pretty'} ? $args{'pretty'} : $Debug;
115 0           my $joins = $args{'joins'};
116 0   0       my $hints = $args{'hints'} || {};
117 0           my $set = delete $args{'set'};
118 0   0       my $table_map = delete $args{'table_map'} || {};
119 0           my $bind_params = $args{'bind_params'};
120 0           my $from_and_where_only = delete $args{'from_and_where_only'};
121 0           my $allow_empty_lists = $args{'allow_empty_lists'};
122 0           my $strict_ops = $args{'strict_ops'};
123 0           my $object_class = $args{'object_class'};
124              
125 0           my $unique_aliases = $args{'unique_aliases'};
126             my $table_aliases = exists $args{'table_aliases'} ?
127 0 0         $args{'table_aliases'} : ($args{'table_aliases'} = 1);
128              
129 0 0         if($args{'limit'})
130             {
131 0           $limit_suffix = 'LIMIT ' . delete $args{'limit'};
132             }
133              
134             # Coerce for_update boolean alias into lock argument
135 0 0         if(delete $args{'for_update'})
136             {
137 0   0       $lock ||= { type => 'for update' };
138             }
139              
140 0 0         $all_columns = $columns unless(%$all_columns);
141              
142 0 0         $logic = " $logic" unless($logic eq ',');
143              
144 0           $args{'_depth'}++;
145              
146 0 0         unless($args{'dbh'})
147             {
148 0 0         if($args{'db'})
149             {
150             $dbh = $args{'db'}->dbh || Carp::croak "Missing 'dbh' argument and ",
151 0   0       "could not retreive one from the 'db' agument - ", $args{'db'}->error;
152             }
153 0           else { Carp::croak "Missing 'dbh' argument" }
154             }
155              
156 0           my $do_bind = wantarray;
157              
158 0           my(@bind, @clauses);
159              
160 0           my %query;
161              
162 0 0         if($query_arg)
163             {
164 0           for(my $i = 0; $i <= $#$query_arg; $i++)
165             {
166 0 0         if($query_arg->[$i] =~ /^(?:and|or)$/i)
    0          
167             {
168 0           my $query = $query_arg->[$i + 1];
169              
170 0 0 0       unless(ref $query && @$query)
171             {
172 0           $i++;
173 0           next;
174             }
175              
176 0           my($sql, $bind);
177              
178 0 0         if($do_bind)
179             {
180 0           ($sql, $bind) =
181             build_select(%args,
182             where_only => 1,
183             query => $query,
184             logic => uc $query_arg->[$i],
185             table_map => $table_map,
186             set => $set);
187              
188 0           push(@bind, @$bind);
189             }
190             else
191             {
192 0           $sql =
193             build_select(%args,
194             where_only => 1,
195             query => $query,
196             logic => uc $query_arg->[$i],
197             table_map => $table_map,
198             set => $set);
199             }
200              
201 0 0         if($pretty)
202             {
203 0           my $pad = ' ' x $args{'_depth'};
204 0           my $sub_pad = ' ' x ($args{'_depth'} - 1);
205              
206 0           for($sql)
207             {
208 0           s/\A //;
209 0           s/^ +$//g;
210 0           s/\s*\Z//;
211             }
212              
213 0           push(@clauses, "(\n" . $sql . "\n" . "$pad)");
214             }
215             else
216             {
217 0           push(@clauses, "($sql)");
218             }
219              
220 0           $i++;
221             }
222             elsif(my $ref = ref $query_arg->[$i])
223             {
224 0 0         if($ref eq 'SCALAR')
    0          
225             {
226 0           push(@clauses, ${$query_arg->[$i]});
  0            
227             }
228             elsif($ref eq 'ARRAY')
229             {
230 0           my $list = $query_arg->[$i];
231              
232 62     62   579 no warnings 'uninitialized';
  62         154  
  62         82035  
233 0 0         unless(ref $list->[0] eq 'SCALAR')
234             {
235 0           Carp::croak "Invalid array reference argument: [ @$list ] - ",
236             "Expected a reference to a scalar followed by zero or more ",
237             "bind arguments";
238             }
239              
240 0           push(@clauses, ${$list->[0]});
  0            
241              
242 0 0         if($do_bind)
243             {
244 0           push(@bind, @$list[1 .. $#$list]);
245 0           push(@$bind_params, undef); # need to offset this list with empty items
246             }
247             }
248             }
249             else
250             {
251 0           push(@{$query{$query_arg->[$i]}}, $query_arg->[$i + 1]);
  0            
252 0           $i++;
253             }
254             }
255             }
256              
257 0           my $query_is_sql = $args{'query_is_sql'};
258              
259 0 0         $select = join(', ', map { ref $_ eq 'SCALAR' ? $$_ : $_ } @$select) if(ref $select);
  0 0          
260 0 0         $sort_by = join(', ', map { ref $_ eq 'SCALAR' ? $$_ : $_ } @$sort_by) if(ref $sort_by);
  0 0          
261 0 0         $group_by = join(', ', @$group_by) if(ref $group_by);
262              
263 0           my($not, $op, @select_columns, %column_count);
264              
265 0           foreach my $table (@$tables)
266             {
267 0 0         next unless($columns->{$table});
268              
269 0           foreach my $column (@{$columns->{$table}})
  0            
270             {
271 0           $column_count{$column}++;
272             }
273             }
274              
275 0 0         my $multi_table = @$tables > 1 ? 1 : 0;
276 0           my $table_num = 1;
277              
278 0 0         if($multi_table)
279             {
280 0           $table_aliases = 1;
281             }
282             else
283             {
284 0 0         $table_aliases = $multi_table unless(defined $table_aliases);
285             }
286              
287 0           my($db, %proto, $do_bind_params); # db object and prototype objects used for formatting values
288              
289 0           foreach my $table (@$tables)
290             {
291 0           my $table_tn = $table_num;
292 0           my $table_alias = 't' . $table_num++;
293              
294             #next unless($all_columns->{$table} ||= $columns->{$table});
295              
296 0           my($classes, $meta, $obj_class, $obj_meta);
297              
298 0           $db = $args{'db'};
299              
300 0 0         unless($query_is_sql)
301             {
302 0 0         $classes = $args{'classes'} or
303             Carp::croak "Missing 'classes' arg which is required unless 'query_is_sql' is true";
304              
305 0   0       $meta = $args{'meta'} || {};
306              
307 0 0         Carp::croak "Missing 'db' arg which is required unless 'query_is_sql' is true"
308             unless($db);
309              
310 0 0         $obj_class = $classes->{$table}
311             or Carp::confess "No class name found for table '$table'";
312              
313 0 0 0       $obj_meta = $meta->{$obj_class} || $obj_class->meta
314             or Carp::confess "No metadata found for class '$obj_class'";
315              
316 0 0 0       if($bind_params && !defined $do_bind_params)
317             {
318 0           $do_bind_params = $obj_meta->dbi_requires_bind_param($db);
319             }
320             }
321              
322 0 0         $bind_params = undef unless($do_bind_params);
323              
324 0           my $query_only_columns = 0;
325 0           my $my_columns = $columns->{$table};
326 0   0       my $all_my_columns = $all_columns->{$table} ||= $my_columns;
327              
328             # No columns to select, but allow them to be queried if we can
329 0 0         if(@$my_columns == 0)
330             {
331             # Don't select these columns, but allow them to participate in the query
332 0           $query_only_columns = 1;
333              
334 0 0         if($obj_meta)
335             {
336 0           $my_columns = $all_my_columns = $obj_meta->column_names;
337             }
338             else # Try to dig out meta object even if query_is_sql
339             {
340 0   0       $meta = $args{'meta'} || {};
341 0           $obj_class = $classes->{$table};
342 0   0       $obj_meta = $meta->{$obj_class} ||
343             ($obj_class ? $obj_class->meta : undef);
344              
345 0 0         if($obj_meta)
346             {
347 0           $my_columns = $obj_meta->column_names;
348             }
349             }
350             }
351              
352 0           my %select_columns = map { $_ => 1 } @$my_columns;
  0            
353              
354 0           foreach my $column (@$all_my_columns)
355             {
356 0           my $fq_column = "$table.$column";
357 0           my $short_column = "$table_alias.$column";
358 0           my $unique_column = "${table_alias}_$column";
359 0 0         my $rel_column = $table_map->{$table_tn} ?
360             "$table_map->{$table_tn}.$column" : '';
361              
362 0           my(@method_columns, $fq_column_trimmed);
363              
364             TRIM:
365             {
366 0           (my $t = $table) =~ s/^[^.]+\.//;
  0            
367 0           $fq_column_trimmed = "$t.$column";
368             }
369              
370             # Avoid duplicate clauses if the table name matches the relationship name
371 0 0         $rel_column = '' if($rel_column eq $fq_column);
372              
373 0 0         if($obj_meta)
374             {
375 0           my $method = $obj_meta->column_rw_method_name($column);
376              
377 0 0         unless($method eq $column)
378             {
379             push(@method_columns,
380             $method,
381             "$table.$method",
382             "$table_alias.$method",
383 0 0         $table_map->{$table_tn} ? "$table_map->{$table_tn}.$method" : ());
384             }
385             }
386              
387 0 0 0       unless($query_only_columns || !$select_columns{$column})
388             {
389 0 0         if($table_aliases)
390             {
391 0 0         push(@select_columns,
    0          
    0          
    0          
    0          
392             $obj_meta ?
393             (
394             $obj_meta->column($column)->select_sql($db, $table_alias) .
395             ($unique_aliases ? (' AS ' . $db->auto_quote_column_name("${table_alias}_$column")) : '')
396             ) :
397             $db ?
398             (
399             $db->auto_quote_column_with_table($column, $table_alias) .
400             ($unique_aliases ? (' AS ' . $db->auto_quote_column_name("${table_alias}_$column")) : '')
401             ) :
402             ($unique_aliases ? "$short_column AS ${table_alias}_$column" : $short_column));
403             }
404             else
405             {
406 0 0         push(@select_columns,
    0          
407             $obj_meta ? $obj_meta->column($column)->select_sql($db) :
408             $db ? $db->auto_quote_column_name($column) : $column);
409             }
410             }
411              
412 0           foreach my $column_arg (grep { exists $query{$_} } map { ($_, "!$_") }
  0            
  0            
413             ($column, $fq_column, $fq_column_trimmed, $short_column,
414             $rel_column, $unique_column, @method_columns))
415             {
416 0 0         $not = (index($column_arg, '!') == 0) ? 'NOT' : '';
417              
418             # Deflate/format values using prototype objects
419 0           foreach my $val (@{$query{$column_arg}})
  0            
420             {
421 0           my $col_meta;
422              
423 0           my $val_ref = ref $val;
424 0           my $scalar_ref = $val_ref eq 'SCALAR';
425              
426 0 0 0       unless($query_is_sql || $scalar_ref)
427             {
428 0           my($obj, $get_method, $set_method);
429              
430 0 0 0       $col_meta = $obj_meta->column($column) || $obj_meta->method_column($column)
431             or Carp::confess "Could not get column metadata object for '$column'";
432              
433 0 0 0       if($get_method || $set_method) # $col_meta->manager_uses_method
434             {
435 0 0         unless($obj = $proto{$obj_class})
436             {
437 0           $obj = $proto{$obj_class} = $obj_class->new(db => $db);
438 0           $obj->{STATE_SAVING()} = 1;
439             }
440              
441 0 0         $get_method = $obj_meta->column_accessor_method_name($column)
442             or Carp::confess "Missing accessor method for column '$column'";
443              
444 0 0         $set_method = $obj_meta->column_mutator_method_name($column)
445             or Carp::confess "Missing mutator method for column '$column'";
446             }
447              
448 0           my %tmp = ($column_arg => $val);
449              
450 0 0 0       if(ref $val eq 'HASH' && ($val->{'any_in_array'} || $val->{'all_in_array'}) &&
      0        
      0        
451 0 0 0       !@{$val->{'any_in_array'} || $val->{'all_in_array'} || []})
452             {
453 0 0         Carp::croak "Empty list not allowed for $column_arg query parameter"
454             unless($allow_empty_lists);
455              
456             # "empty set in array" -> "array column is not null"
457 0           %tmp = ($column_arg => $val = undef);
458 0           $not = 'NOT';
459             }
460              
461 0           _format_value($db, \%tmp, $column_arg, $obj, $col_meta, $get_method, $set_method, $val,
462             undef, undef, $allow_empty_lists);
463              
464 0           $val = $tmp{$column_arg};
465             }
466              
467 0 0 0       if(($column_arg eq $column || $column_arg eq "!$column") &&
      0        
      0        
468             ($column_count{$column} || 0) > 1)
469             {
470 0 0         if($args{'no_ambiguous_columns'})
471             {
472 0           Carp::croak "Column '$column' is ambiguous; it appears in ",
473             "$column_count{$column} tables. Use a fully-qualified ",
474             "column name instead (e.g., $fq_column or $short_column)";
475             }
476             else # unprefixed columns are considered part of t1
477             {
478 0 0         next unless($table_alias eq 't1');
479             }
480             }
481              
482 0 0         my $placeholder = $col_meta ? $col_meta->query_placeholder_sql($db) : '?';
483 0 0         my $sql_column = $table_aliases ? $short_column :
    0          
484             $db ? $db->auto_quote_column_name($column) : $column;
485              
486 0 0         if($val_ref)
    0          
487             {
488 0 0         $val = $$val if($scalar_ref);
489              
490 0 0         push(@clauses, _build_clause($dbh, $sql_column, $op, $val, $not,
491             undef, ($do_bind ? \@bind : undef),
492             $db, $col_meta, $scalar_ref, $set,
493             $placeholder, $bind_params,
494             $allow_empty_lists, $strict_ops));
495             }
496             elsif(!defined $val)
497             {
498 62     62   631 no warnings 'uninitialized';
  62         153  
  62         159422  
499              
500 0 0 0       if($set)
    0          
501             {
502 0           push(@clauses, "$sql_column = NULL");
503             }
504             elsif($op eq 'IS' || $op eq 'IS NOT')
505             {
506 0 0         push(@clauses, ($not ? 'NOT(' : '') . "$sql_column IS " .
    0          
    0          
507             ($op eq 'IS NOT' ? 'NOT ' : '') . 'NULL' .
508             ($not ? ')' : ''));
509             }
510             else
511             {
512 0 0 0       push(@clauses, ("$sql_column IS " . (($not || $op eq '<>') ? "NOT " : '') . 'NULL'));
513             }
514             }
515             else
516             {
517 0 0 0       if($col_meta && $db && $col_meta->should_inline_value($db, $val))
    0 0        
518             {
519 0 0         push(@clauses, ($not ? "$not($sql_column = $val)" : "$sql_column = $val"));
520             }
521             elsif($do_bind)
522             {
523 0 0         push(@clauses, ($not ? "$not($sql_column = $placeholder)" : "$sql_column = $placeholder"));
524 0           push(@bind, $val);
525              
526 0 0         if($do_bind_params)
527             {
528 0           push(@$bind_params, $col_meta->dbi_bind_param_attrs($db));
529             }
530             }
531             else
532             {
533 0 0         push(@clauses, ($not ? "$not($sql_column = " . $dbh->quote($val) . ')' :
534             "$sql_column = " . $dbh->quote($val)));
535             }
536             }
537             }
538 0           delete $query{$column_arg};
539             }
540             }
541             }
542              
543 0 0         if(%query)
544             {
545 0 0         my $s = (scalar keys %query > 1) ? 's' : '';
546 0           Carp::croak "Invalid query parameter$s: ", join(', ', sort keys %query);
547             }
548              
549 0 0         if($clauses_arg)
550             {
551 0           push(@clauses, @$clauses_arg);
552             }
553              
554 0           my $where;
555              
556 0 0         if($pretty)
557             {
558 0           my $pad = ' ' x $args{'_depth'};
559 0           $where = join("$logic\n", map { "$pad$_" } @clauses);
  0            
560             }
561             else
562             {
563 0           $where = join("$logic\n", map { " $_" } @clauses);
  0            
564             }
565              
566 0           my $qs;
567              
568             my $nested_joins = (exists $args{'nested_joins'}) ?
569 0 0         delete $args{'nested_joins'} : ($db ? $db->supports_nested_joins : 1);
    0          
570              
571 0 0         if(!$where_only)
572             {
573 0           my $from_tables_sql;
574              
575             # XXX: Undocumented "joins" parameter is an array indexed by table
576             # alias number. Each value is a hashref that contains a key 'type'
577             # that contains the join type SQL, and 'conditions' that contains a
578             # ref to an array of join conditions SQL.
579             #
580             # If this parameter is passed, then every table except t1 that has
581             # a join type and condition will be joined with an explicit JOIN
582             # statement. Otherwise, an implicit inner join will be used.
583 0 0 0       if($joins && @$joins)
584             {
585 0           my $i = 1;
586 0           my($primary_table, @normal_tables, @joined_tables, @nested);
587              
588 0           foreach my $table (@$tables)
589             {
590             # Main table gets treated specially
591 0 0         if($i == 1)
    0          
592             {
593             #$primary_table = " $tables_sql->[$i - 1] t$i";
594 0 0         if($db)
595             {
596 0           $primary_table = ' ' .
597             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i", $hints);
598             }
599             else
600             {
601 0           $primary_table = " $tables_sql->[$i - 1] t$i";
602             }
603              
604 0           $i++;
605 0           next;
606             }
607             elsif(!$joins->[$i])
608             {
609 0 0         if($db)
610             {
611             push(@normal_tables, ' ' .
612             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i",
613 0           $joins->[$i]{'hints'}));
614             }
615             else
616             {
617 0           push(@normal_tables, " $tables_sql->[$i - 1] t$i");
618             }
619              
620 0           $i++;
621 0           next;
622             }
623              
624             Carp::croak "Missing join type for table '$table'"
625 0 0         unless($joins->[$i]{'type'});
626              
627             Carp::croak "Missing join conditions for table '$table'"
628 0 0         unless($joins->[$i]{'conditions'});
629              
630 0 0         if($nested_joins)
631             {
632 0 0         if(my $parent_tn = $joins->[$i]{'parent_tn'})
633             {
634 0           push(@{$nested[$parent_tn]}, $i);
  0            
635             }
636             else
637             {
638 0           $nested[$i] = [];
639             }
640             }
641             else
642             {
643 0 0         if($db)
644             {
645             push(@joined_tables, " $joins->[$i]{'type'} " .
646             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i",
647             $joins->[$i]{'hints'}) .
648 0           " ON (" . join(' AND ', @{$joins->[$i]{'conditions'}}) . ")");
  0            
649             }
650             else
651             {
652             push(@joined_tables,
653             " $joins->[$i]{'type'} $tables_sql->[$i - 1] t$i ON (" .
654 0           join(' AND ', @{$joins->[$i]{'conditions'}}) . ")");
  0            
655             }
656             }
657              
658 0           $i++;
659             }
660              
661 0 0         if($nested_joins)
662             {
663 0           my @seen;
664              
665 0           for($i = 1; $i <= $#nested; $i++)
666             {
667 0 0         next if($seen[$i]++);
668              
669 0           my $children = $nested[$i];
670              
671 0 0         next unless($children);
672              
673 0 0         if(@$children)
674             {
675 0           push(@joined_tables, _build_nested_join($joins, \@nested, $i, $tables_sql, $db, \@seen));
676             }
677             else
678             {
679 0 0         if($db)
680             {
681             push(@joined_tables, " $joins->[$i]{'type'} " .
682             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i",
683             $joins->[$i]{'hints'}) .
684 0           " ON (" . join(' AND ', @{$joins->[$i]{'conditions'}}) . ")");
  0            
685             }
686             else
687             {
688             push(@joined_tables,
689             " $joins->[$i]{'type'} $tables_sql->[$i - 1] t$i ON (" .
690 0           join(' AND ', @{$joins->[$i]{'conditions'}}) . ")");
  0            
691             }
692             }
693             }
694             }
695              
696             # XXX: This sucks
697 0           my $driver = $dbh->{'Driver'}{'Name'};
698              
699 0 0 0       if($driver eq 'mysql' && @normal_tables &&
    0 0        
      0        
700             (($db && $db->database_version >= 5_000_012) ||
701             $dbh->get_info(SQL_DBMS_VER) =~ /5\.\d+\.(?:1[2-9]|[2-9]\d)/))
702             {
703             # MySQL 5.0.12 and later require the implicitly joined tables
704             # to be grouped with parentheses or explicitly joined.
705              
706             # Explicitly joined:
707             #$from_tables_sql =
708             # join(" JOIN\n", $primary_table, @normal_tables) . "\n" .
709             # join("\n", @joined_tables);
710              
711             # Grouped by parens:
712 0           $from_tables_sql =
713             " (\n" . join(",\n ", " $primary_table", @normal_tables) . "\n )\n" .
714             join("\n", @joined_tables);
715             }
716             elsif($driver eq 'SQLite')
717             {
718             # SQLite 1.12 seems to demand that explicit joins come last.
719             # Older versions seem to like it too, so we'll doit that way
720             # for SQLite in general.
721              
722             # Primary table first, then implicit joins, then explicit joins
723 0           $from_tables_sql =
724             join(",\n", $primary_table, @normal_tables) .
725             join("\n", @joined_tables);
726             }
727             else
728             {
729             # Primary table first, then explicit joins, then implicit inner joins
730 0 0         $from_tables_sql =
731             join("\n", $primary_table, @joined_tables) .
732             (@normal_tables ? ",\n" . join(",\n", @normal_tables) : '');
733             }
734             }
735             else
736             {
737 0           my $i = 0;
738              
739 0   0       my $oracle_hack = $dbh->{'Driver'}{'Name'} eq 'Oracle' && $limit_prefix;
740              
741 0 0         if($db)
742             {
743             $from_tables_sql = $table_aliases ?
744             join(",\n", map
745             {
746 0           $i++;
747 0   0       ' ' . $db->format_table_with_alias($_, "t$i", $hints->{"t$i"} || ($i == 1 ? $hints : undef))
748             } @$tables_sql) :
749             ' ' . (($oracle_hack || keys %$hints) ?
750 0 0 0       $db->format_table_with_alias($tables_sql->[0], "t1", $hints->{'t1'} || $hints) :
    0 0        
751             $tables_sql->[0]);
752             }
753             else
754             {
755             $from_tables_sql = $table_aliases ?
756 0 0         join(",\n", map { $i++; " $_ t$i" } @$tables_sql) :
  0            
  0            
757             " $tables_sql->[0]";
758             }
759             }
760              
761 0   0       $select ||= join(",\n", map { " $_" } @select_columns);
  0            
762              
763 0 0         if($from_and_where_only)
764             {
765 0           $qs = "$from_tables_sql\n";
766             }
767             else
768             {
769 0 0 0       my $select_start = ($db && %$hints) ? $db->format_select_start_sql($hints->{'t1'} || $hints) : 'SELECT';
      0        
770              
771 0 0         if(index($limit_prefix, 'SELECT ') != 0)
772             {
773 0           $qs = "$select_start $limit_prefix$distinct\n$select\nFROM\n$from_tables_sql\n";
774             }
775             else
776             {
777 0           $qs = "${limit_prefix}$select_start$distinct\n$select\nFROM\n$from_tables_sql\n";
778             }
779             }
780             }
781              
782 0 0         if($where)
783             {
784 0 0         if($where_only)
785             {
786 0           $qs = ' ' . $where;
787             }
788             else
789             {
790 0           $qs .= "WHERE\n" . $where;
791             }
792             }
793              
794 0 0         $qs .= "\nGROUP BY " . $group_by if($group_by);
795 0 0         $qs .= "\nORDER BY " . $sort_by if($sort_by);
796 0 0         $qs .= "\n" . $limit_suffix if(defined $limit_suffix);
797 0 0 0       $qs .= "\n" . $db->format_select_lock($object_class, $lock, $tables) if($object_class && $lock);
798              
799 0 0         $Debug && warn "$qs\n";
800              
801 0 0         return wantarray ? ($qs, \@bind) : $qs;
802             }
803              
804             sub _build_clause
805             {
806 0     0     my($dbh, $field, $op, $vals, $not, $field_mod, $bind, $db, $col_meta,
807             $force_inline, $set, $placeholder, $bind_params, $allow_empty_lists,
808             $strict_ops) = @_;
809              
810             #if(ref $vals eq 'ARRAY' && @$vals == 1)
811             #{
812             # $vals = $vals->[0];
813             #}
814              
815 0 0         if(ref $vals eq 'SCALAR')
816             {
817 0           $force_inline = 1;
818 0           $vals = $$vals;
819             }
820              
821 0 0 0       if(!defined $op && ref $vals eq 'HASH' && keys(%$vals) == 1)
      0        
822             {
823 0           my $op_arg = (keys(%$vals))[0];
824              
825 0 0         if($op_arg =~ s/(?:_|^)sql$//)
826             {
827 0           $force_inline = 1;
828             }
829              
830 0 0         unless($op = $Op_Map{$op_arg})
831             {
832 0 0         if($strict_ops)
833             {
834 0           Carp::croak "Unknown comparison operator: $op_arg";
835             }
836 0           else { $op = $op_arg }
837             }
838             }
839 0   0       else { $op ||= '=' }
840              
841 0           my $ref;
842              
843             # XXX: This sucks
844 0 0         my $driver = $db ? $db->driver : '';
845              
846 0 0         unless($ref = ref($vals))
847             {
848 0 0         $field = $field_mod if($field_mod);
849              
850 0   0       my $should_inline =
851             ($db && $col_meta && $col_meta->should_inline_value($db, $vals));
852              
853 0 0         if(defined($vals))
854             {
855 0 0 0       if($bind && !$should_inline && !$force_inline)
      0        
856             {
857 0           push(@$bind, $vals);
858              
859 0 0         if($bind_params)
860             {
861 0           push(@$bind_params, $col_meta->dbi_bind_param_attrs($db));
862             }
863              
864 0 0 0       if($op eq 'ANY IN SET' || $op eq 'ALL IN SET')
    0 0        
865             {
866 0 0         if($driver eq 'mysql')
867             {
868 0 0         return ($not ? "$not(" : '') .
    0          
869             "FIND_IN_SET($placeholder, $field) > 0" . ($not ? ')' : '');
870             }
871             else
872             {
873 0 0         return ($not ? "$not " : '') . "$placeholder IN $field ";
874             }
875             }
876             elsif($op eq 'ANY IN ARRAY' || $op eq 'ALL IN ARRAY')
877             {
878 0 0         return $not ? "NOT ($placeholder = ANY($field))" : "$placeholder = ANY($field)";
879             }
880             else
881             {
882 0 0         return ($not ? "$not(" : '') . "$field $op $placeholder" . ($not ? ')' : '');
    0          
883             }
884             }
885              
886 0 0 0       if($op eq 'ANY IN SET' || $op eq 'ALL IN SET')
    0 0        
887             {
888 0 0         if($driver eq 'mysql')
889             {
890 0 0 0       return ($not ? "$not(" : '') . 'FIND_IN_SET(' .
    0          
    0          
891             (($should_inline || $force_inline) ? $vals : $dbh->quote($vals)) .
892             ", $field) > 0" . ($not ? ')' : '');
893             }
894             else
895             {
896 0 0 0       return ($not ? "$not(" : '') .
    0          
    0          
897             (($should_inline || $force_inline) ? $vals : $dbh->quote($vals)) .
898             " IN $field " . ($not ? ')' : '');
899             }
900             }
901             elsif($op eq 'ANY IN ARRAY' || $op eq 'ALL IN ARRAY')
902             {
903 0 0 0       my $qval = ($should_inline || $force_inline) ? $vals : $dbh->quote($vals);
904 0 0         return $not ? "NOT ($qval = ANY($field)) " : "$qval = ANY($field) ";
905             }
906             else
907             {
908 0 0 0       return ($not ? "$not(" : '') . "$field $op " .
    0          
    0          
909             (($should_inline || $force_inline) ? $vals :
910             $dbh->quote($vals)) .
911             ($not ? ')' : '');
912             }
913             }
914              
915 62     62   643 no warnings 'uninitialized';
  62         206  
  62         32747  
916 0 0 0       if($set)
    0          
917             {
918 0           return "$field = NULL";
919             }
920             elsif($op eq 'IS' || $op eq 'IS NOT')
921             {
922 0 0         return ($not ? 'NOT(' : '') . "$field IS " .
    0          
    0          
923             ($op eq 'IS NOT' ? 'NOT ' : '') . 'NULL' . ($not ? ')' : '');
924             }
925             else
926             {
927 0 0 0       return "$field IS " . (($not || $op eq '<>') ? 'NOT ' : '') . 'NULL';
928             }
929             }
930              
931 0 0         if($ref eq 'ARRAY')
    0          
932             {
933 0 0         if(!@$vals)
934             {
935 0 0         Carp::croak "Empty list not allowed for $field query parameter"
936             unless($allow_empty_lists);
937             }
938             else
939             {
940 0 0         if($op eq '=')
    0          
941             {
942 0           my @new_vals;
943              
944 0           foreach my $val (@$vals)
945             {
946 0   0       my $should_inline =
947             ($db && $col_meta && $col_meta->should_inline_value($db, $val));
948              
949 0 0 0       if(ref $val eq 'SCALAR')
    0          
950             {
951 0           push(@new_vals, $$val);
952             }
953             elsif($should_inline || $force_inline)
954             {
955 0           push(@new_vals, $val);
956             }
957             else
958             {
959 0 0         if($bind)
960             {
961 0 0         if(defined $val)
962             {
963 0           push(@$bind, $val);
964 0           push(@new_vals, $placeholder);
965              
966 0 0         if($bind_params)
967             {
968 0           push(@$bind_params, $col_meta->dbi_bind_param_attrs($db));
969             }
970             }
971             else
972             {
973 0           push(@new_vals, 'NULL');
974             }
975             }
976             else
977             {
978 0           push(@new_vals, $dbh->quote($val));
979             }
980             }
981             }
982              
983 0 0         return "$field " . ($not ? "$not " : '') . 'IN (' . join(', ', @new_vals) . ')';
984             }
985             elsif($op =~ /^(A(?:NY|LL)) IN (SET|ARRAY)$/)
986             {
987 0 0         my $sep = ($1 eq 'ANY') ? 'OR ' : 'AND ';
988 0 0         my $field_sql = ($2 eq 'SET') ? "IN $field" : "= ANY($field)";
989              
990 0 0         if($bind)
991             {
992             return ($not ? "$not " : '') . '(' .
993             join($sep, map
994             {
995 0 0         push(@$bind, $_);
  0 0          
996 0 0         if($bind_params)
997             {
998 0           push(@$bind_params, $col_meta->dbi_bind_param_attrs($db));
999             }
1000             "$placeholder $field_sql "
1001 0           }
1002             (ref $vals ? @$vals : ($vals))) . ')';
1003             }
1004              
1005             return ($not ? "$not " : '') . '(' .
1006             join($sep, map
1007             {
1008 0 0         $dbh->quote($_) . " $field_sql "
  0 0          
1009             }
1010             (ref $vals ? @$vals : ($vals))) . ')';
1011             }
1012              
1013 0 0         if($bind)
1014             {
1015 0           my @new_vals;
1016              
1017 0           foreach my $val (@$vals)
1018             {
1019 62     62   621 no warnings 'uninitialized';
  62         219  
  62         111035  
1020 0 0         if(ref $val eq 'SCALAR')
1021             {
1022 0           push(@new_vals, $$val);
1023 0           next;
1024             }
1025              
1026 0   0       my $should_inline =
1027             ($db && $col_meta && $col_meta->should_inline_value($db, $val));
1028              
1029 0 0 0       if($should_inline || $force_inline)
1030             {
1031 0           push(@new_vals, $val);
1032             }
1033             else
1034             {
1035 0           push(@$bind, $val);
1036 0           push(@new_vals, $placeholder);
1037              
1038 0 0         if($bind_params)
1039             {
1040 0           push(@$bind_params, $col_meta->dbi_bind_param_attrs($db));
1041             }
1042             }
1043             }
1044              
1045 0 0         if($Template_Op{$op})
1046             {
1047 0           for($op)
1048             {
1049 0           s/%COLUMN%/$field/g;
1050 0           s/\?/shift(@new_vals)/ge;
  0            
1051             }
1052              
1053 0 0         return $not ? "NOT ($op)" : $op;
1054             }
1055              
1056 0 0         return '(' . join(' OR ', map { ($not ? "$not(" : '') . "$field $op $_" .
  0 0          
1057             ($not ? ')' : '') } @new_vals) . ')';
1058             }
1059              
1060             return '(' . join(' OR ', map
1061             {
1062 0 0 0       ($not ? "$not(" : '') . "$field $op " .
  0 0          
    0          
1063             (($force_inline || ($db && $col_meta && $col_meta->should_inline_value($db, $_))) ? $_ : $dbh->quote($_)) .
1064             ($not ? ')' : '')
1065             }
1066             @$vals) . ')';
1067             }
1068              
1069 0           return;
1070             }
1071             elsif($ref eq 'HASH')
1072             {
1073 0           my($sub_op, $field_mod, @clauses);
1074              
1075 0 0         $field_mod = delete $vals->{'field'} if(exists $vals->{'field'});
1076              
1077 0 0 0       my $all_in = ($op eq 'ALL IN SET' || $op eq 'ALL IN ARRAY') ? 1 : 0;
1078 0 0 0       my $any_in = ($op eq 'ANY IN SET' || $op eq 'ANY IN ARRAY') ? 1 : 0;
1079              
1080 0           foreach my $raw_op (keys(%$vals))
1081             {
1082 0 0         unless($sub_op = $Op_Map{$raw_op})
1083             {
1084 0 0         Carp::croak "Unknown comparison operator: $raw_op" if($strict_ops);
1085 0           $sub_op = $raw_op;
1086             }
1087              
1088 0           my $ref_type = ref($vals->{$raw_op});
1089              
1090 0 0 0       if(!$ref_type || $ref_type eq 'SCALAR')
    0          
1091             {
1092 0           push(@clauses, _build_clause($dbh, $field, $sub_op, $vals->{$raw_op}, $not, $field_mod, $bind, $db, $col_meta, $force_inline, $set, $placeholder, $bind_params));
1093             }
1094             elsif($ref_type eq 'ARRAY')
1095             {
1096 0 0         my $tmp_not = $all_in ? 0 : $not;
1097              
1098 0 0         if (my $wanted = $Op_Wantarray{$raw_op})
1099             {
1100 0 0 0       if($wanted > 1 && @{$vals->{$raw_op}} > $wanted)
  0            
1101             {
1102 0           Carp::croak "The '$raw_op' operator expects $wanted arguments, but got ", scalar(@{$vals->{$raw_op}});
  0            
1103             }
1104              
1105 0           push(@clauses, _build_clause($dbh, $field, $sub_op, $vals->{$raw_op}, $tmp_not, $field_mod, $bind, $db, $col_meta, $force_inline, $set, $placeholder, $bind_params));
1106             }
1107             else
1108             {
1109 0           foreach my $val (@{$vals->{$raw_op}})
  0            
1110             {
1111 0           push(@clauses, _build_clause($dbh, $field, $sub_op, $val, $tmp_not, $field_mod, $bind, $db, $col_meta, $force_inline, $set, $placeholder, $bind_params));
1112             }
1113             }
1114             }
1115             else
1116             {
1117 0 0         Carp::croak "Don't know how to handle comparison operator '$raw_op' " .
1118             ($col_meta ? ' for column ' . $col_meta->name : '') .
1119             ": $vals->{$raw_op}";
1120             }
1121             }
1122              
1123 0 0         if($all_in)
    0          
1124             {
1125 0 0         if($not)
1126             {
1127 0           return 'NOT(' . join(' AND ', @clauses) . ')';
1128             }
1129             else
1130             {
1131 0 0         return @clauses == 1 ? $clauses[0] : ('(' . join(' AND ', @clauses) . ')');
1132             }
1133             }
1134             elsif($any_in)
1135             {
1136 0 0         if($not)
1137             {
1138 0           return join(' AND ', @clauses);
1139             }
1140             else
1141             {
1142 0 0         return @clauses == 1 ? $clauses[0] : ('(' . join(' OR ', @clauses) . ')');
1143             }
1144             }
1145             else
1146             {
1147 0 0         return @clauses == 1 ? $clauses[0] : ('(' . join(' OR ', @clauses) . ')');
1148             }
1149             }
1150              
1151 0 0         Carp::croak "Don't know how to handle comparison" .
1152             ($col_meta ? ' for column ' . $col_meta->name : '') .
1153             ": $vals";
1154             }
1155              
1156             sub _build_nested_join
1157             {
1158 0     0     my($joins, $nested, $i, $tables_sql, $db, $seen) = @_;
1159              
1160 0           $seen->[$i] = 1;
1161              
1162 0 0 0       if($nested->[$i] && @{$nested->[$i]})
  0            
1163             {
1164 0           my $join_sql;
1165              
1166 0 0         if($joins->[$i])
1167             {
1168 0           my $child_num = 0;
1169              
1170 0           $join_sql = " $joins->[$i]{'type'} (";
1171              
1172 0 0         if($db)
1173             {
1174             $join_sql .=
1175             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i",
1176 0           $joins->[$i]{'hints'});
1177             }
1178             else
1179             {
1180 0           $join_sql .= "$tables_sql->[$i - 1] t$i";
1181             }
1182              
1183 0           foreach my $child_tn (@{$nested->[$i]})
  0            
1184             {
1185 0           $join_sql .= _build_nested_join($joins, $nested, $child_tn, $tables_sql, $db, $seen);
1186             }
1187              
1188 0           $join_sql .= ") ON (" . join(' AND ', @{$joins->[$i]{'conditions'}}) . ")";
  0            
1189 0           return $join_sql;
1190             }
1191             else
1192             {
1193 0           foreach my $child_tn (@{$nested->[$i]})
  0            
1194             {
1195 0           $join_sql .= _build_nested_join($joins, $nested, $child_tn, $tables_sql, $db, $seen);
1196             }
1197              
1198 0           return $join_sql;
1199             }
1200             }
1201             else
1202             {
1203 0 0         if($db)
1204             {
1205             return " $joins->[$i]{'type'} " .
1206             $db->format_table_with_alias($tables_sql->[$i - 1], "t$i",
1207             $joins->[$i]{'hints'}) .
1208 0           " ON (" . join(' AND ', @{$joins->[$i]{'conditions'}}) . ")";
  0            
1209             }
1210             else
1211             {
1212             return
1213             " $joins->[$i]{'type'} $tables_sql->[$i - 1] t$i ON (" .
1214 0           join(' AND ', @{$joins->[$i]{'conditions'}}) . ")";
  0            
1215             }
1216             }
1217             }
1218              
1219             sub _format_value
1220             {
1221 0     0     my($db, $store, $param, $object, $col_meta, $get_method, $set_method,
1222             $value, $asis, $depth, $allow_empty_lists) = @_;
1223              
1224 0   0       $depth ||= 1;
1225              
1226 0           my $val_ref = ref $value;
1227              
1228 0 0 0       if(!$val_ref || $asis)
    0          
    0          
1229             {
1230 0 0 0       unless(ref $store eq 'HASH' && $Op_Arg_PassThru{$param})
1231             {
1232 0 0         if($col_meta->manager_uses_method)
    0          
1233             {
1234 0           $object->$set_method($value);
1235 0           $value = $object->$get_method();
1236             }
1237             elsif(defined $value)
1238             {
1239 0           my $parsed_value = $col_meta->parse_value($db, $value);
1240              
1241             # XXX: Every column class should support parse_error(), but for now
1242             # XXX: the undef check should cover those that don't
1243 0 0 0       if(defined $value && !defined $parsed_value) #|| $col_meta->parse_error)
1244             {
1245 0           Carp::croak $col_meta->parse_error;
1246             }
1247              
1248 0 0         $value = $col_meta->format_value($db, $parsed_value)
1249             if(defined $value);
1250             }
1251             }
1252             }
1253             elsif($val_ref eq 'ARRAY')
1254             {
1255 0 0 0       Carp::croak "Empty list not allowed for $param query parameter"
1256             unless(@$value || $allow_empty_lists);
1257              
1258 0 0 0       if($asis || $col_meta->type eq 'array' ||
    0 0        
      0        
1259             ($col_meta->type eq 'set' && $depth == 1))
1260             {
1261 0           $value = _format_value($db, $value, undef, $object, $col_meta, $get_method, $set_method, $value, 1, $depth + 1, $allow_empty_lists);
1262             }
1263             elsif($col_meta->type ne 'set')
1264             {
1265 0           my @vals;
1266              
1267 0           foreach my $subval (@$value)
1268             {
1269 0           _format_value($db, \@vals, undef, $object, $col_meta, $get_method, $set_method, $subval, 0, $depth + 1, $allow_empty_lists);
1270             }
1271              
1272 0           $value = \@vals;
1273             }
1274             }
1275             elsif($val_ref eq 'HASH')
1276             {
1277 0           foreach my $key (keys %$value)
1278             {
1279 0 0         next if($key =~ /(?:_|^)sql$/); # skip inline values
1280 0           _format_value($db, $value, $key, $object, $col_meta, $get_method, $set_method, $value->{$key}, 0, $depth + 1, $allow_empty_lists);
1281             }
1282             }
1283             else
1284             {
1285 0 0 0       if($col_meta->manager_uses_method)
    0          
1286             {
1287 0           $object->$set_method($value);
1288 0           $value = $object->$get_method();
1289             }
1290             elsif(defined $value && $val_ref ne 'SCALAR')
1291             {
1292 0           my $parsed_value = $col_meta->parse_value($db, $value);
1293              
1294             # XXX: Every column class should support parse_error(), but for now
1295             # XXX: the undef check should cover those that don't
1296 0 0 0       if(defined $value && !defined $parsed_value) #|| $col_meta->parse_error)
1297             {
1298 0           Carp::croak $col_meta->parse_error;
1299             }
1300              
1301 0 0         $value = $col_meta->format_value($db, $parsed_value)
1302             if(defined $value);
1303             }
1304             }
1305              
1306 0 0         if(ref $store eq 'HASH')
    0          
1307             {
1308 0 0         defined $param || die "Missing param argument for hashref storage";
1309 0           $store->{$param} = $value;
1310             }
1311             elsif(ref $store eq 'ARRAY')
1312             {
1313 0           push(@$store, $value);
1314             }
1315 0           else { die "Don't know how to store $value in $store" }
1316              
1317 0           return $value;
1318             }
1319              
1320             1;
1321              
1322             __END__
1323              
1324             =head1 NAME
1325              
1326             Rose::DB::Object::QueryBuilder - Build SQL queries on behalf of Rose::DB::Object::Manager.
1327              
1328             =head1 SYNOPSIS
1329              
1330             use Rose::DB::Object::QueryBuilder qw(build_select);
1331              
1332             # Build simple query
1333             $sql = build_select
1334             (
1335             dbh => $dbh,
1336             select => 'COUNT(*)',
1337             tables => [ 'articles' ],
1338             columns => { articles => [ qw(id category type title date) ] },
1339             query =>
1340             [
1341             category => [ 'sports', 'science' ],
1342             type => 'news',
1343             title => { like => [ '%million%',
1344             '%resident%' ] },
1345             ],
1346             query_is_sql => 1);
1347              
1348             $sth = $dbh->prepare($sql);
1349             $sth->execute;
1350             $count = $sth->fetchrow_array;
1351              
1352             ...
1353              
1354             # Return query with placeholders, plus bind values
1355             ($sql, $bind) = build_select
1356             (
1357             dbh => $dbh,
1358             tables => [ 'articles' ],
1359             columns => { articles => [ qw(id category type title date) ] },
1360             query =>
1361             [
1362             category => [ 'sports', 'science' ],
1363             type => 'news',
1364             title => { like => [ '%million%',
1365             '%resident%' ] },
1366             ],
1367             query_is_sql => 1,
1368             sort_by => 'title DESC, category',
1369             limit => 5);
1370              
1371             $sth = $dbh->prepare($sql);
1372             $sth->execute(@$bind);
1373              
1374             while($row = $sth->fetchrow_hashref) { ... }
1375              
1376             ...
1377              
1378             # Coerce query values into the right format
1379             ($sql, $bind) = build_select
1380             (
1381             db => $db,
1382             tables => [ 'articles' ],
1383             columns => { articles => [ qw(id category type title date) ] },
1384             classes => { articles => 'Article' },
1385             query =>
1386             [
1387             type => 'news',
1388             date => { lt => 'now' },
1389             date => { gt => DateTime->new(...) },
1390             ],
1391             sort_by => 'title DESC, category',
1392             limit => 5);
1393              
1394             $sth = $dbh->prepare($sql);
1395             $sth->execute(@$bind);
1396              
1397             =head1 DESCRIPTION
1398              
1399             L<Rose::DB::Object::QueryBuilder> is used to build SQL queries, primarily in service of the L<Rose::DB::Object::Manager> class. It (optionally) exports two functions: L<build_select()|/build_select> and L<build_where_clause()|/build_where_clause>.
1400              
1401             =head1 FUNCTIONS
1402              
1403             =over 4
1404              
1405             =item B<build_select PARAMS>
1406              
1407             Returns an SQL "select" query string (in scalar context) or an SQL "select" query string with placeholders and a reference to an array of bind values (in list context) constructed based on PARAMS. Valid PARAMS are described below.
1408              
1409             =over 4
1410              
1411             =item B<clauses CLAUSES>
1412              
1413             A reference to an array of extra SQL clauses to add to the "WHERE" portion of the query string. This is the obligatory "escape hatch" for clauses that are not supported by arguments to the L<query|/query> parameter.
1414              
1415             =item B<columns HASHREF>
1416              
1417             A reference to a hash keyed by table name, each of which points to a reference to an array of the names of the columns in that table. Example:
1418              
1419             $sql = build_select(columns =>
1420             {
1421             table1 => [ 'col1', 'col2', ... ],
1422             table2 => [ 'col1', 'col2', ... ],
1423             ...
1424             });
1425              
1426             This argument is required.
1427              
1428             =item B<db DB>
1429              
1430             A L<Rose::DB>-derived object. This argument is required if L<query_is_sql|/query_is_sql> is false or omitted.
1431              
1432             =item B<dbh DBH>
1433              
1434             A L<DBI> database handle already connected to the correct database. If this argument is omitted, an attempt will be made to extract a database handle from the L<db|/db> argument. If this fails, or if there is no L<db|/db> argument, a fatal error will occur.
1435              
1436             =item B<group_by CLAUSE>
1437              
1438             A fully formed SQL "GROUP BY ..." clause, sans the words "GROUP BY", or a reference to an array of strings to be joined with a comma and appended to the "GROUP BY" clause.
1439              
1440             =item B<limit NUMBER>
1441              
1442             A number to use in the "LIMIT ..." clause.
1443              
1444             =item B<logic LOGIC>
1445              
1446             A string indicating the logic that will be used to join the statements in the WHERE clause. Valid values for LOGIC are "AND" and "OR". If omitted, it defaults to "AND".
1447              
1448             =item B<pretty BOOL>
1449              
1450             If true, the SQL returned will have slightly nicer formatting.
1451              
1452             =item B<query PARAMS>
1453              
1454             The query parameters, passed as a reference to an array of name/value pairs, scalar references, or array references. PARAMS may include an arbitrary list of selection parameters used to modify the "WHERE" clause of the SQL select statement. Any query parameter that is not in one of the forms described below will cause a fatal error.
1455              
1456             Valid selection parameters are described below, along with the SQL clause they add to the select statement.
1457              
1458             Simple equality:
1459              
1460             'NAME' => "foo" # COLUMN = 'foo'
1461             '!NAME' => "foo" # NOT(COLUMN = 'foo')
1462              
1463             'NAME' => [ "a", "b" ] # COLUMN IN ('a', 'b')
1464             '!NAME' => [ "a", "b" ] # COLUMN NOT(IN ('a', 'b'))
1465              
1466             Is/is not null:
1467              
1468             'NAME' => undef # COLUMN IS NULL
1469             '!NAME' => undef # COLUMN IS NOT NULL
1470              
1471             'NAME' => { eq => undef } # COLUMN IS NULL
1472             'NAME' => { ne => undef } # COLUMN IS NOT NULL
1473              
1474             Comparisons:
1475              
1476             NAME => { OP => "foo" } # COLUMN OP 'foo'
1477              
1478             # (COLUMN OP 'foo' OR COLUMN OP 'goo')
1479             NAME => { OP => [ "foo", "goo" ] }
1480              
1481             "OP" can be any of the following:
1482              
1483             OP SQL operator
1484             ------------- ------------
1485             similar SIMILAR TO
1486             match ~
1487             imatch ~*
1488             regex, regexp REGEXP
1489             like LIKE
1490             ilike ILIKE
1491             rlike RLIKE
1492             is IS
1493             is_not IS NOT
1494             ne <>
1495             eq =
1496             lt <
1497             gt >
1498             le <=
1499             ge >=
1500              
1501             Ranges:
1502              
1503             NAME => { between => [ 1, 99 ] } # COLUMN BETWEEN 1 AND 99
1504              
1505             NAME => { gt_lt => [ 1, 99 ] } # (COLUMN > 1 AND < 99)
1506             NAME => { gt_le => [ 1, 99 ] } # (COLUMN > 1 AND <= 99)
1507             NAME => { ge_lt => [ 1, 99 ] } # (COLUMN >= 1 AND < 99)
1508             NAME => { ge_le => [ 1, 99 ] } # (COLUMN >= 1 AND <= 99)
1509              
1510             If a value is a reference to a scalar, that scalar is "inlined" without any quoting.
1511              
1512             'NAME' => \"foo" # COLUMN = foo
1513             'NAME' => [ "a", \"b" ] # COLUMN IN ('a', b)
1514              
1515             Undefined values are translated to the keyword NULL when included in a multi-value comparison.
1516              
1517             'NAME' => [ "a", undef ] # COLUMN IN ('a', NULL)
1518              
1519             Set operations:
1520              
1521             ### Informix (default) ###
1522              
1523             # A IN COLUMN
1524             'NAME' => { in_set => 'A' }
1525              
1526             # NOT(A IN COLUMN)
1527             '!NAME' => { in_set => 'A' }
1528              
1529             # (A IN COLUMN OR B IN COLUMN)
1530             'NAME' => { in_set => [ 'A', 'B'] }
1531             'NAME' => { any_in_set => [ 'A', 'B'] }
1532              
1533             # NOT(A IN COLUMN) AND NOT(B IN COLUMN)
1534             '!NAME' => { in_set => [ 'A', 'B'] }
1535             '!NAME' => { any_in_set => [ 'A', 'B'] }
1536              
1537             # (A IN COLUMN AND B IN COLUMN)
1538             'NAME' => { all_in_set => [ 'A', 'B'] }
1539              
1540             # NOT(A IN COLUMN AND B IN COLUMN)
1541             '!NAME' => { all_in_set => [ 'A', 'B'] }
1542              
1543             ### MySQL (requires db parameter) ###
1544              
1545             # FIND_IN_SET(A, COLUMN) > 0
1546             'NAME' => { in_set => 'A' }
1547              
1548             # NOT(FIND_IN_SET(A, COLUMN) > 0)
1549             '!NAME' => { in_set => 'A' }
1550              
1551             # (FIND_IN_SET(A, COLUMN) > 0 OR FIND_IN_SET(B, COLUMN) > 0)
1552             'NAME' => { in_set => [ 'A', 'B'] }
1553             'NAME' => { any_in_set => [ 'A', 'B'] }
1554              
1555             # NOT(FIND_IN_SET(A, COLUMN) > 0) AND NOT(FIND_IN_SET(B, COLUMN) > 0)
1556             '!NAME' => { in_set => [ 'A', 'B'] }
1557             '!NAME' => { any_in_set => [ 'A', 'B'] }
1558              
1559             # (FIND_IN_SET(A, COLUMN) > 0 AND FIND_IN_SET(B, COLUMN) > 0)
1560             'NAME' => { all_in_set => [ 'A', 'B'] }
1561              
1562             # NOT(FIND_IN_SET(A, COLUMN) > 0 AND FIND_IN_SET(B, COLUMN) > 0)
1563             '!NAME' => { all_in_set => [ 'A', 'B'] }
1564              
1565             Array operations:
1566              
1567             # A = ANY(COLUMN)
1568             'NAME' => { in_array => 'A' }
1569              
1570             # NOT(A = ANY(COLUMN))
1571             '!NAME' => { in_array => 'A' }
1572              
1573             # (A = ANY(COLUMN) OR B = ANY(COLUMN))
1574             'NAME' => { in_array => [ 'A', 'B'] }
1575             'NAME' => { any_in_array => [ 'A', 'B'] }
1576              
1577             # NOT(A = ANY(COLUMN) OR B = ANY(COLUMN))
1578             '!NAME' => { in_array => [ 'A', 'B'] }
1579             '!NAME' => { any_in_array => [ 'A', 'B'] }
1580              
1581             # (A = ANY(COLUMN) AND B = ANY(COLUMN))
1582             'NAME' => { all_in_array => [ 'A', 'B'] }
1583              
1584             # NOT(A = ANY(COLUMN) AND B = ANY(COLUMN))
1585             '!NAME' => { all_in_array => [ 'A', 'B'] }
1586              
1587             PostgreSQL ltree operations:
1588              
1589             OP SQL operator
1590             ------------- ------------
1591             ltree_ancestor @>
1592             ltree_descendant <@
1593             ltree_query ~
1594             ltree_ltxtquery @
1595             ltree_concat ||
1596              
1597             Any of the operations described above can have "_sql" appended to indicate that the corresponding values are to be "inlined" (i.e., included in the SQL query as-is, with no quoting of any kind). This is useful for comparing two columns. For example, this query:
1598              
1599             query => [ legs => { gt_sql => 'eyes' } ]
1600              
1601             would produce this SQL:
1602              
1603             SELECT ... FROM animals WHERE legs > eyes
1604              
1605             where "legs" and "eyes" are both left unquoted.
1606              
1607             The same NAME string may be repeated multiple times. (This is the primary reason that the query is a reference to an I<array> of name/value pairs, rather than a reference to a hash, which would only allow each NAME once.) Example:
1608              
1609             query =>
1610             [
1611             age => { gt => 10 },
1612             age => { lt => 20 },
1613             ]
1614              
1615             The string "NAME" can take many forms, each of which eventually resolves to a database column (COLUMN in the examples above).
1616              
1617             Literal SQL can be included by providing a reference to a scalar:
1618              
1619             \'mycol > 123'
1620              
1621             To use placeholders and bind values, pass a reference to an array containing a scalar reference to the literal SQL with placeholders as the first item, followed by a list of values to bind:
1622              
1623             [ \'mycol > ?' => 123 ]
1624              
1625             =over 4
1626              
1627             =item C<column>
1628              
1629             A bare column name. If the query includes more than one table, the column name may be ambiguous if it appears in two or more tables. In that case, a fatal error will occur. To solve this, use one of the less ambiguous forms below.
1630              
1631             =item C<table.column>
1632              
1633             A column name and a table name joined by a dot. This is the "fully qualified" column name.
1634              
1635             =item C<tN.column>
1636              
1637             A column name and a table alias joined by a dot. The table alias is in the form "tN", where "N" is a number starting from 1. See the documentation for L<tables|/tables> parameter below to learn how table aliases are assigned to tables.
1638              
1639             =item Any of the above prefixed with "!"
1640              
1641             This indicates the negation of the specified condition.
1642              
1643             =back
1644              
1645             If L<query_is_sql|/query_is_sql> is false or omitted, then NAME can also take on these additional forms:
1646              
1647             =over 4
1648              
1649             =item C<method>
1650              
1651             A L<get_set|Rose::DB::Object::Metadata::Column/MAKING_METHODS> column method name from a L<Rose::DB::Object>-derived class fronting one of the tables being queried. There may be ambiguity here if the same method name is defined on more than one of the classes involved in the query. In such a case, the method will be mapped to the first L<Rose::DB::Object>-derived class that contains a method by that name, considered in the order that the tables are provided in the L<tables|/tables> parameter.
1652              
1653             =item C<!method>
1654              
1655             This indicates the negation of the specified condition.
1656              
1657             =back
1658              
1659             Un-prefixed column or method names that are ambiguous (i.e., exist in more than one of the tables being queried) are considered to be part of the primary table ("t1").
1660              
1661             Finally, in the case of apparently intractable ambiguity, like when a table name is the same as another table's alias, remember that you can always use the "tn_"-prefixed column name aliases, which are unique within a given query.
1662              
1663             All of these clauses are joined by L<logic|/logic> (default: "AND") in the final query. Example:
1664              
1665             $sql = build_select
1666             (
1667             dbh => $dbh,
1668             select => 'id, title',
1669             tables => [ 'articles' ],
1670             columns => { articles => [ qw(id category type title) ] },
1671             query =>
1672             [
1673             category => [ 'sports', 'science' ],
1674             type => 'news',
1675             title => { like => [ '%million%',
1676             '%resident%' ] },
1677             ],
1678             query_is_sql => 1);
1679              
1680             The above returns an SQL statement something like this:
1681              
1682             SELECT id, title FROM articles WHERE
1683             category IN ('sports', 'science')
1684             AND
1685             type = 'news'
1686             AND
1687             (title LIKE '%million%' OR title LIKE '%resident%')
1688             LIMIT 5
1689              
1690             Nested boolean logic is possible using the special keywords C<and> and C<or> (case insensitive). Example:
1691              
1692             $sql = build_select
1693             (
1694             dbh => $dbh,
1695             select => 'id, title',
1696             tables => [ 'articles' ],
1697             columns => { articles => [ qw(id category type title) ] },
1698             query =>
1699             [
1700             or =>
1701             [
1702             and => [ category => undef, type => 'aux' ],
1703             category => [ 'sports', 'science' ],
1704             ],
1705             type => 'news',
1706             title => { like => [ '%million%',
1707             '%resident%' ] },
1708             ],
1709             query_is_sql => 1);
1710              
1711             which returns an SQL statement something like this:
1712              
1713             SELECT id, title FROM articles WHERE
1714             (
1715             (
1716             category IS NULL AND
1717             type = 'aux'
1718             )
1719             OR category IN ('sports', 'science')
1720             )
1721             AND
1722             type = 'news'
1723             AND
1724             (title LIKE '%million%' OR title LIKE '%resident%')
1725              
1726             The C<and> and C<or> keywords can be used multiple times within a query (just like all other NAME specifiers described earlier) and can be arbitrarily nested.
1727              
1728             If you have a column named "and" or "or", you'll have to use the fully-qualified (table.column) or alias-qualified (tN.column) forms in order to address that column.
1729              
1730             If L<query_is_sql|/query_is_sql> is false or omitted, all of the parameter values are passed through the C<parse_value()> and C<format_value()> methods of their corresponding L<Rose::DB::Object::Metadata::Column>-derived column objects.
1731              
1732             If a column object returns true from its L<manager_uses_method()|Rose::DB::Object::Metadata::Column/manager_uses_method> method, then its parameter value is passed through the corresponding L<Rose::DB::Object>-derived object method instead.
1733              
1734             Example:
1735              
1736             $dt = DateTime->new(year => 2001, month => 1, day => 31);
1737              
1738             $sql = build_select
1739             (
1740             db => $db,
1741             select => 'id, category',
1742             tables => [ 'articles' ],
1743             columns => { articles => [ qw(id category type date) ] },
1744             classes => { articles => 'Article' },
1745             query =>
1746             [
1747             type => 'news',
1748             date => { lt => '12/25/2003 8pm' },
1749             date => { gt => $dt },
1750             ],
1751             sort_by => 'id DESC, category',
1752             limit => 5);
1753              
1754             The above returns an SQL statement something like this:
1755              
1756             SELECT id, category FROM articles WHERE
1757             type = 'news'
1758             AND
1759             date < '2003-12-25 20:00:00'
1760             AND
1761             date > '2001-01-31 00:00:00'
1762             ORDER BY id DESC, category
1763             LIMIT 5
1764              
1765             Finally, here's an example using more than one table:
1766              
1767             $dt = DateTime->new(year => 2001, month => 1, day => 31);
1768              
1769             $sql = build_select
1770             (
1771             db => $db,
1772             tables => [ 'articles', 'categories' ],
1773             columns =>
1774             {
1775             articles => [ qw(id name category_id date) ],
1776             categories => [ qw(id name description) ],
1777             },
1778             classes =>
1779             {
1780             articles => 'Article',
1781             categories => 'Category',
1782             },
1783             query =>
1784             [
1785             '!t1.name' => { like => '%foo%' },
1786             t2.name => 'news',
1787             date => { lt => '12/25/2003 8pm' },
1788             date => { gt => $dt },
1789             ],
1790             clauses =>
1791             [
1792             't1.category_id = t2.id',
1793             ],
1794             sort_by => 'articles.name DESC, t2.name',
1795             limit => 5);
1796              
1797             The above returns an SQL statement something like this:
1798              
1799             SELECT
1800             t1.id,
1801             t1.name,
1802             t1.category_id,
1803             t1.date,
1804             t2.id,
1805             t2.name,
1806             t2.description
1807             FROM
1808             articles t1,
1809             categories t2
1810             WHERE
1811             t1.category_id = t2.id
1812             AND
1813             NOT(t1.name LIKE '%foo%')
1814             AND
1815             t2.name = 'news'
1816             AND
1817             t1.date < '2003-12-25 20:00:00'
1818             AND
1819             t1.date > '2001-01-31 00:00:00'
1820             ORDER BY articles.name DESC, t2.name
1821             LIMIT 5
1822              
1823             =item B<query_is_sql BOOL>
1824              
1825             If omitted, this boolean flag is false. If true, then the values of the L<query|/query> parameters are taken as literal strings that are suitable for direct use in SQL queries. Example:
1826              
1827             $sql = build_select
1828             (
1829             query_is_sql => 1,
1830             query =>
1831             [
1832             date => { lt => '2003-12-25 20:00:00' },
1833             ],
1834             ...
1835             );
1836              
1837             Here the date value "2003-12-25 20:00:00" must be in the format that the current database expects for columns of that data type.
1838              
1839             But if L<query_is_sql|/query_is_sql> is false or omitted, then any query value that can be handled by the L<Rose::DB::Object>-derived object method that services the corresponding database column is valid. (Note that this is only possible when this method is called from one of the built-in L<Rose::DB::Object::Manager> methods, e.g., L<get_objects()|Rose::DB::Object::Manager/get_objects>.)
1840              
1841             Example:
1842              
1843             $dt = DateTime->new(year => 2001, month => 1, day => 31);
1844              
1845             $sql = build_select
1846             (
1847             query =>
1848             [
1849             date => { gt => $dt },
1850             date => { lt => '12/25/2003 8pm' },
1851             ],
1852             ...
1853             );
1854              
1855             Here a L<DateTime> object and a loosely formatted date are passed as values. Provided the L<Rose::DB::Object>-derived object method that services the "date" column can handle such values, they will be parsed and formatted as appropriate for the current database.
1856              
1857             The advantage of this approach is that the query values do not have to be so rigorously specified, nor do they have to be in a database-specific format.
1858              
1859             The disadvantage is that all of this parsing and formatting is done for every query value, and that adds additional overhead to each call.
1860              
1861             Usually, this overhead is dwarfed by the time required for the database to service the query, and, perhaps more importantly, the reduced maintenance headache and busywork required to properly format all query values.
1862              
1863             =item B<select COLUMNS>
1864              
1865             The names of the columns to select from the table. COLUMNS may be a string of comma-separated column names, or a reference to an array of column names. If this parameter is omitted, it defaults to all of the columns in all of the tables participating in the query (according to the value of the L<columns|/columns> argument).
1866              
1867             =item B<sort_by [ CLAUSE | ARRAYREF ]>
1868              
1869             A fully formed SQL "ORDER BY ..." clause, sans the words "ORDER BY", or a reference to an array of strings to be joined with a comma and appended to the "ORDER BY" clause.
1870              
1871             If an item in the referenced array is itself a reference to a scalar, then that item will be dereferenced and passed through unmodified.
1872              
1873             =item B<tables TABLES>
1874              
1875             A reference to an array of table names. This argument is required. A fatal error will occur if it is omitted.
1876              
1877             If more than one table is in the list, then each table is aliased to "tN", where N is an ascending number starting with 1. The tables are numbered according to their order in TABLES. Example:
1878              
1879             $sql = build_select(tables => [ 'foo', 'bar', 'baz' ], ...);
1880              
1881             print $sql;
1882              
1883             # SELECT ... FROM
1884             # foo AS t1,
1885             # bar AS t2,
1886             # baz AS t3
1887             # ...
1888              
1889             Furthermore, if there is no explicit value for the L<select|/select> parameter and if the L<unique_aliases|/unique_aliases> parameter is set to true, then each selected column is aliased with a "tN_" prefix in a multi-table query. Example:
1890              
1891             SELECT
1892             t1.id AS t1_id,
1893             t1.name AS t1_name,
1894             t2.id AS t2_id,
1895             t2.name AS t2_name
1896             FROM
1897             foo AS t1,
1898             bar AS t2
1899             WHERE
1900             ...
1901              
1902             These unique aliases provide a technique of last resort for unambiguously addressing a column in a query clause.
1903              
1904             =item B<unique_aliases BOOL>
1905              
1906             If true, then each selected column will be given a unique alias by prefixing it with its table alias and an underscore. The default value is false. See the documentation for the L<tables|/tables> parameter above for an example.
1907              
1908             =back
1909              
1910             =item B<build_where_clause PARAMS>
1911              
1912             This works the same as the L<build_select()|/build_select> function, except that it only returns the "WHERE" clause of the SQL query, sans the word "WHERE" and prefixed with a single space.
1913              
1914             =back
1915              
1916             =head1 AUTHOR
1917              
1918             John C. Siracusa (siracusa@gmail.com)
1919              
1920             =head1 LICENSE
1921              
1922             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is
1923             free software; you can redistribute it and/or modify it under the same terms
1924             as Perl itself.