File Coverage

blib/lib/DBIx/SearchBuilder.pm
Criterion Covered Total %
statement 455 502 90.6
branch 183 234 78.2
condition 85 129 65.8
subroutine 68 79 86.0
pod 46 47 97.8
total 837 991 84.4


line stmt bran cond sub pod time code
1              
2             package DBIx::SearchBuilder;
3              
4 13     13   80889 use strict;
  13         34  
  13         452  
5 13     13   105 use warnings;
  13         28  
  13         635  
6              
7             our $VERSION = "1.77";
8              
9 13     13   5943 use Clone qw();
  13         31337  
  13         325  
10 13     13   707 use Encode qw();
  13         10980  
  13         253  
11 13     13   65 use Scalar::Util qw(blessed);
  13         34  
  13         750  
12 13     13   484 use DBIx::SearchBuilder::Util qw/ sorted_values /;
  13         30  
  13         89307  
13             our $PREFER_BIND = $ENV{SB_PREFER_BIND};
14              
15             =head1 NAME
16              
17             DBIx::SearchBuilder - Encapsulate SQL queries and rows in simple perl objects
18              
19             =head1 SYNOPSIS
20              
21             use DBIx::SearchBuilder;
22              
23             package My::Things;
24             use base qw/DBIx::SearchBuilder/;
25              
26             sub _Init {
27             my $self = shift;
28             $self->Table('Things');
29             return $self->SUPER::_Init(@_);
30             }
31              
32             sub NewItem {
33             my $self = shift;
34             # MyThing is a subclass of DBIx::SearchBuilder::Record
35             return(MyThing->new);
36             }
37              
38             package main;
39              
40             use DBIx::SearchBuilder::Handle;
41             my $handle = DBIx::SearchBuilder::Handle->new();
42             $handle->Connect( Driver => 'SQLite', Database => "my_test_db" );
43              
44             my $sb = My::Things->new( Handle => $handle );
45              
46             $sb->Limit( FIELD => "column_1", VALUE => "matchstring" );
47              
48             while ( my $record = $sb->Next ) {
49             print $record->my_column_name();
50             }
51              
52             =head1 DESCRIPTION
53              
54             This module provides an object-oriented mechanism for retrieving and updating data in a DBI-accesible database.
55              
56             In order to use this module, you should create a subclass of C and a
57             subclass of C for each table that you wish to access. (See
58             the documentation of C for more information on subclassing it.)
59              
60             Your C subclass must override C, and probably should override
61             at least C<_Init> also; at the very least, C<_Init> should probably call C<_Handle> and C<_Table>
62             to set the database handle (a C object) and table name for the class.
63             You can try to override just about every other method here, as long as you think you know what you
64             are doing.
65              
66             =head1 METHOD NAMING
67              
68             Each method has a lower case alias; '_' is used to separate words.
69             For example, the method C has the alias C.
70              
71             =head1 METHODS
72              
73             =cut
74              
75              
76             =head2 new
77              
78             Creates a new SearchBuilder object and immediately calls C<_Init> with the same parameters
79             that were passed to C. If you haven't overridden C<_Init> in your subclass, this means
80             that you should pass in a C (or one of its subclasses) like this:
81              
82             my $sb = My::DBIx::SearchBuilder::Subclass->new( Handle => $handle );
83              
84             However, if your subclass overrides _Init you do not need to take a Handle argument, as long
85             as your subclass returns an appropriate handle object from the C<_Handle> method. This is
86             useful if you want all of your SearchBuilder objects to use a shared global handle and don't want
87             to have to explicitly pass it in each time, for example.
88              
89             =cut
90              
91             sub new {
92 115     115 1 27290 my $proto = shift;
93 115   66     512 my $class = ref($proto) || $proto;
94 115         290 my $self = {};
95 115         226 bless( $self, $class );
96 115         426 $self->_Init(@_);
97 115         306 return ($self);
98             }
99              
100              
101              
102             =head2 _Init
103              
104             This method is called by C with whatever arguments were passed to C.
105             By default, it takes a C object as a C
106             argument, although this is not necessary if your subclass overrides C<_Handle>.
107              
108             =cut
109              
110             sub _Init {
111 115     115   552 my $self = shift;
112 115         376 my %args = ( Handle => undef,
113             @_ );
114 115         478 $self->_Handle( $args{'Handle'} );
115              
116 115         314 $self->CleanSlate();
117             }
118              
119              
120              
121             =head2 CleanSlate
122              
123             This completely erases all the data in the SearchBuilder object. It's
124             useful if a subclass is doing funky stuff to keep track of a search and
125             wants to reset the SearchBuilder data without losing its own data;
126             it's probably cleaner to accomplish that in a different way, though.
127              
128             =cut
129              
130             sub CleanSlate {
131 153     153 1 7360 my $self = shift;
132 153         549 $self->RedoSearch();
133 153         279 $self->{'itemscount'} = 0;
134 153         299 $self->{'limit_clause'} = "";
135 153         246 $self->{'order'} = "";
136 153         323 $self->{'alias_count'} = 0;
137 153         239 $self->{'first_row'} = 0;
138 153         234 $self->{'must_redo_search'} = 1;
139 153         366 $self->{'show_rows'} = 0;
140 153         294 $self->{'joins_are_distinct'} = undef;
141 153         228 @{ $self->{'aliases'} } = ();
  153         369  
142              
143 153         989 delete $self->{$_} for qw(
144             items
145             left_joins
146             count_all
147             subclauses
148             restrictions
149             _open_parens
150             _close_parens
151             group_by
152             columns
153             query_hint
154             _bind_values
155             _prefer_bind
156             _combine_search_and_count
157             );
158              
159             #we have no limit statements. DoSearch won't work.
160 153         417 $self->_isLimited(0);
161             }
162              
163             =head2 Clone
164              
165             Returns copy of the current object with all search restrictions.
166              
167             =cut
168              
169             sub Clone
170             {
171 12     12 1 81 my $self = shift;
172              
173 12         37 my $obj = bless {}, ref($self);
174 12         102 %$obj = %$self;
175              
176 12         80 delete $obj->{$_} for qw(
177             items
178             );
179 12         23 $obj->{'must_redo_search'} = 1;
180 12         39 $obj->{'itemscount'} = 0;
181              
182             $obj->{ $_ } = Clone::clone( $obj->{ $_ } )
183 12         68 foreach grep exists $self->{ $_ }, $self->_ClonedAttributes;
184 12         44 return $obj;
185             }
186              
187             =head2 _ClonedAttributes
188              
189             Returns list of the object's fields that should be copied.
190              
191             If your subclass store references in the object that should be copied while
192             clonning then you probably want override this method and add own values to
193             the list.
194              
195             =cut
196              
197             sub _ClonedAttributes
198             {
199 12     12   190 return qw(
200             aliases
201             left_joins
202             subclauses
203             restrictions
204             order_by
205             group_by
206             columns
207             query_hint
208             );
209             }
210              
211              
212              
213             =head2 _Handle [DBH]
214              
215             Get or set this object's DBIx::SearchBuilder::Handle object.
216              
217             =cut
218              
219             sub _Handle {
220 2806     2806   7879 my $self = shift;
221 2806 100       5509 if (@_) {
222 115         368 $self->{'DBIxHandle'} = shift;
223             }
224 2806         8301 return ( $self->{'DBIxHandle'} );
225             }
226              
227             =head2 _DoSearch
228              
229             This internal private method actually executes the search on the database;
230             it is called automatically the first time that you actually need results
231             (such as a call to C).
232              
233             =cut
234              
235             sub _DoSearch {
236 157     157   233 my $self = shift;
237              
238 157 100       370 if ( $self->{_combine_search_and_count} ) {
239 34         76 my ($count) = $self->_DoSearchAndCount;
240 34         103 return $count;
241             }
242              
243 123         312 my $QueryString = $self->BuildSelectQuery();
244 123 100       274 my $records = $self->_Handle->SimpleQuery( $QueryString, @{ $self->{_bind_values} || [] } );
  123         675  
245 123         514 return $self->__DoSearch($records);
246             }
247              
248             sub __DoSearch {
249 159     159   277 my $self = shift;
250 159         240 my $records = shift;
251              
252             # If we're about to redo the search, we need an empty set of items and a reset iterator
253 159         332 delete $self->{'items'};
254 159         365 $self->{'itemscount'} = 0;
255              
256 159 50       422 return 0 unless $records;
257              
258 159         6035 while ( my $row = $records->fetchrow_hashref() ) {
259              
260             # search_builder_count_all is from combine search
261 1202 100 100     4530 if ( !$self->{count_all} && $row->{search_builder_count_all} ) {
262 36         57 $self->{count_all} = $row->{search_builder_count_all};
263             }
264              
265 1202         2847 my $item = $self->NewItem();
266 1202         3119 $item->LoadFromHash($row);
267 1202         2357 $self->AddRecord($item);
268             }
269 159 50       832 return $self->_RecordCount if $records->err;
270              
271 159         372 $self->{'must_redo_search'} = 0;
272              
273 159         426 return $self->_RecordCount;
274             }
275              
276              
277             =head2 AddRecord RECORD
278              
279             Adds a record object to this collection.
280              
281             =cut
282              
283             sub AddRecord {
284 1202     1202 1 2053 my $self = shift;
285 1202         1593 my $record = shift;
286 1202         1661 push @{$self->{'items'}}, $record;
  1202         17982  
287             }
288              
289             =head2 _RecordCount
290              
291             This private internal method returns the number of Record objects saved
292             as a result of the last query.
293              
294             =cut
295              
296             sub _RecordCount {
297 1458     1458   2035 my $self = shift;
298 1458 100       2821 return 0 unless defined $self->{'items'};
299 1447         1847 return scalar @{ $self->{'items'} };
  1447         4329  
300             }
301              
302              
303              
304             =head2 _DoCount
305              
306             This internal private method actually executes a counting operation on the database;
307             it is used by C and C.
308              
309             =cut
310              
311              
312             sub _DoCount {
313 62     62   128 my $self = shift;
314              
315 62 100       160 if ( $self->{_combine_search_and_count} ) {
316 2         10 (undef, my $count_all) = $self->_DoSearchAndCount;
317 2         7 return $count_all;
318             }
319              
320 60         194 my $QueryString = $self->BuildSelectCountQuery();
321 60 100       138 my $records = $self->_Handle->SimpleQuery( $QueryString, @{ $self->{_bind_values} || [] } );
  60         318  
322 60 50       196 return 0 unless $records;
323              
324 60         1308 my @row = $records->fetchrow_array();
325 60 50       446 return 0 if $records->err;
326              
327 60         172 $self->{'count_all'} = $row[0];
328              
329 60         783 return ( $row[0] );
330             }
331              
332             =head2 _DoSearchAndCount
333              
334             This internal private method actually executes the search and also counting on the database;
335              
336             =cut
337              
338             sub _DoSearchAndCount {
339 36     36   50 my $self = shift;
340              
341 36         81 my $QueryString = $self->BuildSelectAndCountQuery();
342 36 50       90 my $records = $self->_Handle->SimpleQuery( $QueryString, @{ $self->{_bind_values} || [] } );
  36         183  
343              
344 36         125 $self->{count_all} = 0;
345             # __DoSearch updates count_all
346 36         100 my $count = $self->__DoSearch($records);
347 36         547 return ( $count, $self->{count_all} );
348             }
349              
350             =head2 _ApplyLimits STATEMENTREF
351              
352             This routine takes a reference to a scalar containing an SQL statement.
353             It massages the statement to limit the returned rows to only C<< $self->RowsPerPage >>
354             rows, skipping C<< $self->FirstRow >> rows. (That is, if rows are numbered
355             starting from 0, row number C<< $self->FirstRow >> will be the first row returned.)
356             Note that it probably makes no sense to set these variables unless you are also
357             enforcing an ordering on the rows (with C, say).
358              
359             =cut
360              
361              
362             sub _ApplyLimits {
363 182     182   292 my $self = shift;
364 182         249 my $statementref = shift;
365 182         377 $self->_Handle->ApplyLimits($statementref, $self->RowsPerPage, $self->FirstRow, $self);
366 38         72 $$statementref =~ s/main\.\*/join(', ', @{$self->{columns}})/eg
  38         179  
367 182 100 66     534 if $self->{columns} and @{$self->{columns}};
  38         257  
368             }
369              
370              
371             =head2 _DistinctQuery STATEMENTREF
372              
373             This routine takes a reference to a scalar containing an SQL statement.
374             It massages the statement to ensure a distinct result set is returned.
375              
376             =cut
377              
378             sub _DistinctQuery {
379 47     47   64 my $self = shift;
380 47         87 my $statementref = shift;
381              
382             # XXX - Postgres gets unhappy with distinct and OrderBy aliases
383 47         84 $self->_Handle->DistinctQuery($statementref, $self)
384             }
385              
386             =head2 _DistinctQueryAndCount STATEMENTREF
387              
388             This routine takes a reference to a scalar containing an SQL statement.
389             It massages the statement to ensure a distinct result set and total number
390             of potential records are returned.
391              
392             =cut
393              
394             sub _DistinctQueryAndCount {
395 33     33   53 my $self = shift;
396 33         50 my $statementref = shift;
397              
398 33         62 $self->_Handle->DistinctQueryAndCount($statementref, $self);
399             }
400              
401             =head2 _BuildJoins
402              
403             Build up all of the joins we need to perform this query.
404              
405             =cut
406              
407              
408             sub _BuildJoins {
409 256     256   435 my $self = shift;
410              
411 256         510 return ( $self->_Handle->_BuildJoins($self) );
412             }
413              
414              
415             =head2 _isJoined
416              
417             Returns true if this SearchBuilder will be joining multiple tables together.
418              
419             =cut
420              
421             sub _isJoined {
422 255     255   12396 my $self = shift;
423 255 100       425 if ( keys %{ $self->{'left_joins'} } ) {
  255         750  
424 109         324 return (1);
425             } else {
426 146         289 return (@{ $self->{'aliases'} });
  146         492  
427             }
428              
429             }
430              
431              
432              
433              
434             # LIMIT clauses are used for restricting ourselves to subsets of the search.
435              
436              
437              
438             sub _LimitClause {
439 0     0   0 my $self = shift;
440 0         0 my $limit_clause;
441              
442 0 0       0 if ( $self->RowsPerPage ) {
443 0         0 $limit_clause = " LIMIT ";
444 0 0       0 if ( $self->FirstRow != 0 ) {
445 0         0 $limit_clause .= $self->FirstRow . ", ";
446             }
447 0         0 $limit_clause .= $self->RowsPerPage;
448             }
449             else {
450 0         0 $limit_clause = "";
451             }
452 0         0 return $limit_clause;
453             }
454              
455              
456              
457             =head2 _isLimited
458              
459             If we've limited down this search, return true. Otherwise, return false.
460              
461             =cut
462              
463             sub _isLimited {
464 2037     2037   2872 my $self = shift;
465 2037 100       3727 if (@_) {
466 324         771 $self->{'is_limited'} = shift;
467             }
468             else {
469 1713         4354 return ( $self->{'is_limited'} );
470             }
471             }
472              
473              
474              
475              
476             =head2 BuildSelectQuery PreferBind => 1|0
477              
478             Builds a query string for a "SELECT rows from Tables" statement for this SearchBuilder object
479              
480             If C is true, the generated query will use bind variables where
481             possible. If C is not passed, it defaults to package variable
482             C<$DBIx::SearchBuilder::PREFER_BIND>, which defaults to
483             C<$ENV{SB_PREFER_BIND}>.
484              
485             To override global C<$DBIx::SearchBuilder::PREFER_BIND> for current object
486             only, you can also set C<_prefer_bind> accordingly, e.g.
487              
488             $sb->{_prefer_bind} = 1;
489              
490             =cut
491              
492             sub BuildSelectQuery {
493 146     146 1 272 my $self = shift;
494              
495             # The initial SELECT or SELECT DISTINCT is decided later
496              
497 146         323 my $QueryString = $self->_BuildJoins . " ";
498 146 100       346 $QueryString .= $self->_WhereClause . " "
499             if ( $self->_isLimited > 0 );
500              
501 146         581 $self->_OptimizeQuery(\$QueryString, @_);
502              
503 146         345 my $QueryHint = $self->QueryHintFormatted;
504              
505             # DISTINCT query only required for multi-table selects
506             # when we have group by clause then the result set is distinct as
507             # it must contain only columns we group by or results of aggregate
508             # functions which give one result per group, so we can skip DISTINCTing
509 146 100 100     400 if ( my $clause = $self->_GroupClause ) {
    100          
510 5         16 $QueryString = "SELECT" . $QueryHint . "main.* FROM $QueryString";
511 5         14 $QueryString .= $clause;
512 5         12 $QueryString .= $self->_OrderClause;
513             }
514             elsif ( !$self->{'joins_are_distinct'} && $self->_isJoined ) {
515 47         137 $self->_DistinctQuery(\$QueryString);
516             }
517             else {
518 94         295 $QueryString = "SELECT" . $QueryHint . "main.* FROM $QueryString";
519 94         254 $QueryString .= $self->_OrderClause;
520             }
521              
522 146         559 $self->_ApplyLimits(\$QueryString);
523              
524 146         583 return($QueryString)
525              
526             }
527              
528              
529              
530             =head2 BuildSelectCountQuery PreferBind => 1|0
531              
532             Builds a SELECT statement to find the number of rows this SearchBuilder object would find.
533              
534             =cut
535              
536             sub BuildSelectCountQuery {
537 70     70 1 114 my $self = shift;
538              
539             #TODO refactor DoSearch and DoCount such that we only have
540             # one place where we build most of the querystring
541 70         181 my $QueryString = $self->_BuildJoins . " ";
542              
543 70 100       199 $QueryString .= $self->_WhereClause . " "
544             if ( $self->_isLimited > 0 );
545              
546 70         286 $self->_OptimizeQuery(\$QueryString, @_);
547              
548             # DISTINCT query only required for multi-table selects
549 70 100       171 if ($self->_isJoined) {
550 29         69 $QueryString = $self->_Handle->DistinctCount(\$QueryString, $self);
551             } else {
552 41         96 my $QueryHint = $self->QueryHintFormatted;
553              
554 41         133 $QueryString = "SELECT" . $QueryHint . "count(main.id) FROM " . $QueryString;
555             }
556              
557 70         217 return ($QueryString);
558             }
559              
560             =head2 BuildSelectAndCountQuery PreferBind => 1|0
561              
562             Builds a query string that is a combination of BuildSelectQuery and
563             BuildSelectCountQuery.
564              
565             =cut
566              
567             sub BuildSelectAndCountQuery {
568 36     36 1 55 my $self = shift;
569              
570             # Generally it's BuildSelectQuery plus extra COUNT part.
571 36         85 my $QueryString = $self->_BuildJoins . " ";
572 36 100       97 $QueryString .= $self->_WhereClause . " "
573             if ( $self->_isLimited > 0 );
574              
575 36         143 $self->_OptimizeQuery( \$QueryString, @_ );
576              
577 36         74 my $QueryHint = $self->QueryHintFormatted;
578              
579 36 50 66     83 if ( my $clause = $self->_GroupClause ) {
    100          
580 0         0 $QueryString
581             = "SELECT" . $QueryHint . "main.*, COUNT(main.id) OVER() AS search_builder_count_all FROM $QueryString";
582 0         0 $QueryString .= $clause;
583 0         0 $QueryString .= $self->_OrderClause;
584             }
585             elsif ( !$self->{'joins_are_distinct'} && $self->_isJoined ) {
586 33         88 $self->_DistinctQueryAndCount( \$QueryString );
587             }
588             else {
589 3         11 $QueryString
590             = "SELECT" . $QueryHint . "main.*, COUNT(main.id) OVER() AS search_builder_count_all FROM $QueryString";
591 3         12 $QueryString .= $self->_OrderClause;
592             }
593              
594 36         143 $self->_ApplyLimits( \$QueryString );
595 36         89 return ($QueryString);
596             }
597              
598              
599             =head2 Next
600              
601             Returns the next row from the set as an object of the type defined by sub NewItem.
602             When the complete set has been iterated through, returns undef and resets the search
603             such that the following call to Next will start over with the first item retrieved from the database.
604              
605             =cut
606              
607              
608              
609             sub Next {
610 1251     1251 1 12655 my $self = shift;
611 1251         1752 my @row;
612              
613 1251 100       2056 return (undef) unless ( $self->_isLimited );
614              
615 1248 100       2666 $self->_DoSearch() if $self->{'must_redo_search'};
616              
617 1248 100       2324 if ( $self->{'itemscount'} < $self->_RecordCount ) { #return the next item
618 1141         1780 my $item = ( $self->{'items'}[ $self->{'itemscount'} ] );
619 1141         1516 $self->{'itemscount'}++;
620 1141         2384 return ($item);
621             }
622             else { #we've gone through the whole list. reset the count.
623 107         266 $self->GotoFirstItem();
624 107         279 return (undef);
625             }
626             }
627              
628              
629              
630             =head2 GotoFirstItem
631              
632             Starts the recordset counter over from the first item. The next time you call Next,
633             you'll get the first item returned by the database, as if you'd just started iterating
634             through the result set.
635              
636             =cut
637              
638              
639             sub GotoFirstItem {
640 196     196 1 323 my $self = shift;
641 196         424 $self->GotoItem(0);
642             }
643              
644              
645              
646              
647             =head2 GotoItem
648              
649             Takes an integer N and sets the record iterator to N. The first time L
650             is called afterwards, it will return the Nth item found by the search.
651              
652             You should only call GotoItem after you've already fetched at least one result
653             or otherwise forced the search query to run (such as via L).
654             If GotoItem is called before the search query is ever run, it will reset the
655             item iterator and L will return the L item.
656              
657             =cut
658              
659             sub GotoItem {
660 200     200 1 312 my $self = shift;
661 200         284 my $item = shift;
662 200         391 $self->{'itemscount'} = $item;
663             }
664              
665              
666              
667             =head2 First
668              
669             Returns the first item
670              
671             =cut
672              
673             sub First {
674 54     54 1 2134 my $self = shift;
675 54         179 $self->GotoFirstItem();
676 54         141 return ( $self->Next );
677             }
678              
679              
680              
681             =head2 Last
682              
683             Returns the last item
684              
685             =cut
686              
687             sub Last {
688 4     4 1 12 my $self = shift;
689 4 100       22 $self->_DoSearch if $self->{'must_redo_search'};
690 4         23 $self->GotoItem( ( $self->Count ) - 1 );
691 4         23 return ( $self->Next );
692             }
693              
694             =head2 DistinctFieldValues
695              
696             Returns list with distinct values of field. Limits on collection
697             are accounted, so collection should be Led to get values
698             from the whole table.
699              
700             Takes paramhash with the following keys:
701              
702             =over 4
703              
704             =item Field
705              
706             Field name. Can be first argument without key.
707              
708             =item Order
709              
710             'ASC', 'DESC' or undef. Defines whether results should
711             be sorted or not. By default results are not sorted.
712              
713             =item Max
714              
715             Maximum number of elements to fetch.
716              
717             =back
718              
719             =cut
720              
721             sub DistinctFieldValues {
722 4     4 1 14 my $self = shift;
723 4 50       26 my %args = (
724             Field => undef,
725             Order => undef,
726             Max => undef,
727             @_%2 ? (Field => @_) : (@_)
728             );
729              
730 4         16 my $query_string = $self->_BuildJoins;
731 4 100       10 $query_string .= ' '. $self->_WhereClause
732             if $self->_isLimited > 0;
733              
734 4         13 my $query_hint = $self->QueryHintFormatted;
735              
736 4         10 my $column = 'main.'. $args{'Field'};
737 4         14 $query_string = "SELECT" . $query_hint . "DISTINCT $column FROM $query_string";
738              
739 4 50       21 if ( $args{'Order'} ) {
740             $query_string .= ' ORDER BY '. $column
741 4 100       37 .' '. ($args{'Order'} =~ /^des/i ? 'DESC' : 'ASC');
742             }
743              
744 4         11 my $dbh = $self->_Handle->dbh;
745 4         39 my $list = $dbh->selectcol_arrayref( $query_string, { MaxRows => $args{'Max'} } );
746 4 50       1546 return $list? @$list : ();
747             }
748              
749              
750              
751             =head2 ItemsArrayRef
752              
753             Return a reference to an array containing all objects found by this search.
754              
755             =cut
756              
757             sub ItemsArrayRef {
758 25     25 1 3904 my $self = shift;
759              
760             #If we're not limited, return an empty array
761 25 100       69 return [] unless $self->_isLimited;
762              
763             #Do a search if we need to.
764 24 100       113 $self->_DoSearch() if $self->{'must_redo_search'};
765              
766             #If we've got any items in the array, return them.
767             # Otherwise, return an empty array
768 24   50     210 return ( $self->{'items'} || [] );
769             }
770              
771              
772              
773              
774             =head2 NewItem
775              
776             NewItem must be subclassed. It is used by DBIx::SearchBuilder to create record
777             objects for each row returned from the database.
778              
779             =cut
780              
781             sub NewItem {
782 0     0 1 0 my $self = shift;
783              
784 0         0 die
785             "DBIx::SearchBuilder needs to be subclassed. you can't use it directly.\n";
786             }
787              
788              
789              
790             =head2 RedoSearch
791              
792             Takes no arguments. Tells DBIx::SearchBuilder that the next time it's asked
793             for a record, it should requery the database
794              
795             =cut
796              
797             sub RedoSearch {
798 402     402 1 4839 my $self = shift;
799 402         776 $self->{'must_redo_search'} = 1;
800             }
801              
802             =head2 CombineSearchAndCount 1|0
803              
804             Tells DBIx::SearchBuilder if it shall search both records and the total count
805             in a single query.
806              
807             =cut
808              
809             my $unsupported_combine_search_and_count_logged;
810             sub CombineSearchAndCount {
811 67     67 1 234 my $self = shift;
812 67 50       127 if ( @_ ) {
813 67 50       146 if ( $self->_Handle->HasSupportForCombineSearchAndCount ) {
814 67         110 $self->{'_combine_search_and_count'} = shift;
815             }
816             else {
817 0 0       0 warn "Current database version " . $self->_Handle->DatabaseVersion . " does not support CombineSearchAndCount. Consider upgrading to a newer version with support for windowing functions." unless $unsupported_combine_search_and_count_logged;
818 0   0     0 $unsupported_combine_search_and_count_logged ||= 1;
819 0         0 return undef;
820             }
821             }
822 67         114 return $self->{'_combine_search_and_count'};
823             }
824              
825              
826             =head2 UnLimit
827              
828             UnLimit clears all restrictions and causes this object to return all
829             rows in the primary table.
830              
831             =cut
832              
833             sub UnLimit {
834 74     74 1 1248 my $self = shift;
835 74         152 $self->_isLimited(-1);
836             }
837              
838              
839              
840             =head2 Limit
841              
842             Limit takes a hash of parameters with the following keys:
843              
844             =over 4
845              
846             =item TABLE
847              
848             Can be set to something different than this table if a join is
849             wanted (that means we can't do recursive joins as for now).
850              
851             =item ALIAS
852              
853             Unless ALIAS is set, the join criterias will be taken from EXT_LINKFIELD
854             and INT_LINKFIELD and added to the criterias. If ALIAS is set, new
855             criterias about the foreign table will be added.
856              
857             =item LEFTJOIN
858              
859             To apply the Limit inside the ON clause of a previously created left
860             join, pass this option along with the alias returned from creating
861             the left join. ( This is similar to using the EXPRESSION option when
862             creating a left join but this allows you to refer to the join alias
863             in the expression. )
864              
865             =item FIELD
866              
867             Column to be checked against.
868              
869             =item FUNCTION
870              
871             Function that should be checked against or applied to the FIELD before
872             check. See L for rules.
873              
874             =item VALUE
875              
876             Should always be set and will always be quoted.
877              
878             =item OPERATOR
879              
880             OPERATOR is the SQL operator to use for this phrase. Possible choices include:
881              
882             =over 4
883              
884             =item "="
885              
886             =item "!="
887              
888             =item "LIKE"
889              
890             In the case of LIKE, the string is surrounded in % signs. Yes. this is a bug.
891              
892             =item "NOT LIKE"
893              
894             =item "STARTSWITH"
895              
896             STARTSWITH is like LIKE, except it only appends a % at the end of the string
897              
898             =item "ENDSWITH"
899              
900             ENDSWITH is like LIKE, except it prepends a % to the beginning of the string
901              
902             =item "MATCHES"
903              
904             MATCHES is equivalent to the database's LIKE -- that is, it's actually LIKE, but
905             doesn't surround the string in % signs as LIKE does.
906              
907             =item "IN" and "NOT IN"
908              
909             VALUE can be an array reference or an object inherited from this class. If
910             it's not then it's treated as any other operator and in most cases SQL would
911             be wrong. Values in array are considered as constants and quoted according
912             to QUOTEVALUE.
913              
914             If object is passed as VALUE then its select statement is used. If no L
915             is selected then C is used, if more than one selected then warning is issued
916             and first column is used.
917              
918             =back
919              
920             =item ENTRYAGGREGATOR
921              
922             Can be C or C (or anything else valid to aggregate two clauses in SQL).
923             Special value is C which means that no entry aggregator should be used.
924             The default value is C.
925              
926             =item CASESENSITIVE
927              
928             on some databases, such as postgres, setting CASESENSITIVE to 1 will make
929             this search case sensitive
930              
931             =item SUBCLAUSE
932              
933             Subclause allows you to assign tags to Limit statements. Statements with
934             matching SUBCLAUSE tags will be grouped together in the final SQL statement.
935              
936             Example:
937              
938             Suppose you want to create Limit statements which would produce results
939             the same as the following SQL:
940              
941             SELECT * FROM Users WHERE EmailAddress OR Name OR RealName OR Email LIKE $query;
942              
943             You would use the following Limit statements:
944              
945             $folks->Limit( FIELD => 'EmailAddress', OPERATOR => 'LIKE', VALUE => "$query", SUBCLAUSE => 'groupsearch');
946             $folks->Limit( FIELD => 'Name', OPERATOR => 'LIKE', VALUE => "$query", SUBCLAUSE => 'groupsearch');
947             $folks->Limit( FIELD => 'RealName', OPERATOR => 'LIKE', VALUE => "$query", SUBCLAUSE => 'groupsearch');
948              
949             =back
950              
951             =cut
952              
953             sub Limit {
954 97     97 1 5557 my $self = shift;
955 97         266 my %args = (
956             TABLE => $self->Table,
957             ALIAS => undef,
958             FIELD => undef,
959             FUNCTION => undef,
960             VALUE => undef,
961             QUOTEVALUE => 1,
962             ENTRYAGGREGATOR => undef,
963             CASESENSITIVE => undef,
964             OPERATOR => '=',
965             SUBCLAUSE => undef,
966             LEFTJOIN => undef,
967             @_ # get the real argumentlist
968             );
969              
970 97 100       279 unless ( $args{'ENTRYAGGREGATOR'} ) {
971 96 100       214 if ( $args{'LEFTJOIN'} ) {
972 2         5 $args{'ENTRYAGGREGATOR'} = 'AND';
973             } else {
974 94         173 $args{'ENTRYAGGREGATOR'} = 'OR';
975             }
976             }
977              
978              
979             #since we're changing the search criteria, we need to redo the search
980 97         253 $self->RedoSearch();
981              
982 97 50       240 if ( $args{'OPERATOR'} ) {
983             #If it's a like, we supply the %s around the search term
984 97 100       646 if ( $args{'OPERATOR'} =~ /LIKE/i ) {
    100          
    100          
    100          
985 8         32 $args{'VALUE'} = "%" . $args{'VALUE'} . "%";
986             }
987             elsif ( $args{'OPERATOR'} =~ /STARTSWITH/i ) {
988 1         4 $args{'VALUE'} = $args{'VALUE'} . "%";
989             }
990             elsif ( $args{'OPERATOR'} =~ /ENDSWITH/i ) {
991 1         5 $args{'VALUE'} = "%" . $args{'VALUE'};
992             }
993             elsif ( $args{'OPERATOR'} =~ /\bIN$/i ) {
994 42 100 66     255 if ( blessed $args{'VALUE'} && $args{'VALUE'}->isa(__PACKAGE__) ) {
    50          
995             # if no columns selected then select id
996 3         9 local $args{'VALUE'}{'columns'} = $args{'VALUE'}{'columns'};
997 3 100 33     8 unless ( $args{'VALUE'}{'columns'} ) {
998 2         10 $args{'VALUE'}->Column( FIELD => 'id' );
999             } elsif ( @{ $args{'VALUE'}{'columns'} } > 1 ) {
1000             warn "Collection in '$args{OPERATOR}' with more than one column selected, using first";
1001             splice @{ $args{'VALUE'}{'columns'} }, 1;
1002             }
1003 3         12 $args{'VALUE'} = '('. $args{'VALUE'}->BuildSelectQuery(PreferBind => 0) .')';
1004 3         12 $args{'QUOTEVALUE'} = 0;
1005             }
1006             elsif ( ref $args{'VALUE'} ) {
1007 39 50       85 if ( $args{'QUOTEVALUE'} ) {
1008 39         84 my $dbh = $self->_Handle->dbh;
1009 39         90 $args{'VALUE'} = join ', ', map $dbh->quote( $_ ), @{ $args{'VALUE'} };
  39         263  
1010             } else {
1011 0         0 $args{'VALUE'} = join ', ', @{ $args{'VALUE'} };
  0         0  
1012             }
1013 39         905 $args{'VALUE'} = "($args{VALUE})";
1014 39         75 $args{'QUOTEVALUE'} = 0;
1015             }
1016             else {
1017             # otherwise behave in backwards compatible way
1018             }
1019             }
1020 97         248 $args{'OPERATOR'} =~ s/(?:MATCHES|ENDSWITH|STARTSWITH)/LIKE/i;
1021              
1022 97 100       346 if ( $args{'OPERATOR'} =~ /IS/i ) {
1023 10         21 $args{'VALUE'} = 'NULL';
1024 10         18 $args{'QUOTEVALUE'} = 0;
1025             }
1026             }
1027              
1028 97 100       229 if ( $args{'QUOTEVALUE'} ) {
1029             #if we're explicitly told not to to quote the value or
1030             # we're doing an IS or IS NOT (null), don't quote the operator.
1031              
1032 43         159 $args{'VALUE'} = $self->_Handle->dbh->quote( $args{'VALUE'} );
1033             }
1034              
1035 97         1017 my $Alias = $self->_GenericRestriction(%args);
1036              
1037 97 50       268 warn "No table alias set!"
1038             unless $Alias;
1039              
1040             # We're now limited. people can do searches.
1041              
1042 97         258 $self->_isLimited(1);
1043              
1044 97 50       241 if ( defined($Alias) ) {
1045 97         359 return ($Alias);
1046             }
1047             else {
1048 0         0 return (1);
1049             }
1050             }
1051              
1052              
1053              
1054             sub _GenericRestriction {
1055 97     97   183 my $self = shift;
1056 97         286 my %args = ( TABLE => $self->Table,
1057             FIELD => undef,
1058             FUNCTION => undef,
1059             VALUE => undef,
1060             ALIAS => undef,
1061             LEFTJOIN => undef,
1062             ENTRYAGGREGATOR => undef,
1063             OPERATOR => '=',
1064             SUBCLAUSE => undef,
1065             CASESENSITIVE => undef,
1066             QUOTEVALUE => undef,
1067             @_ );
1068              
1069             #TODO: $args{'VALUE'} should take an array of values and generate
1070             # the proper where clause.
1071              
1072             #If we're performing a left join, we really want the alias to be the
1073             #left join criterion.
1074              
1075 97 100 66     333 if ( defined $args{'LEFTJOIN'} && !defined $args{'ALIAS'} ) {
1076 2         6 $args{'ALIAS'} = $args{'LEFTJOIN'};
1077             }
1078              
1079             # if there's no alias set, we need to set it
1080              
1081 97 100       251 unless ( $args{'ALIAS'} ) {
1082              
1083             #if the table we're looking at is the same as the main table
1084 47 50       117 if ( $args{'TABLE'} eq $self->Table ) {
1085              
1086             # TODO this code assumes no self joins on that table.
1087             # if someone can name a case where we'd want to do that,
1088             # I'll change it.
1089              
1090 47         101 $args{'ALIAS'} = 'main';
1091             }
1092              
1093             # if we're joining, we need to work out the table alias
1094             else {
1095 0         0 $args{'ALIAS'} = $self->NewAlias( $args{'TABLE'} );
1096             }
1097             }
1098              
1099             # Set this to the name of the field and the alias, unless we've been
1100             # handed a subclause name
1101              
1102 97   66     479 my $ClauseId = $args{'SUBCLAUSE'} || ($args{'ALIAS'} . "." . $args{'FIELD'});
1103              
1104             # If we're trying to get a leftjoin restriction, let's set
1105             # $restriction to point there. Otherwise, let's construct normally.
1106              
1107 97         163 my $restriction;
1108 97 100       267 if ( $args{'LEFTJOIN'} ) {
1109 2 50       19 if ( $args{'ENTRYAGGREGATOR'} ) {
1110             $self->{'left_joins'}{ $args{'LEFTJOIN'} }{'entry_aggregator'} =
1111 2         8 $args{'ENTRYAGGREGATOR'};
1112             }
1113 2   50     14 $restriction = $self->{'left_joins'}{ $args{'LEFTJOIN'} }{'criteria'}{ $ClauseId } ||= [];
1114             }
1115             else {
1116 95   100     552 $restriction = $self->{'restrictions'}{ $ClauseId } ||= [];
1117             }
1118              
1119 97         435 my $QualifiedField = $self->CombineFunctionWithField( %args );
1120              
1121             # If it's a new value or we're overwriting this sort of restriction,
1122              
1123 97 100 33     260 if ( $self->_Handle->CaseSensitive && defined $args{'VALUE'} && $args{'VALUE'} ne '' && $args{'VALUE'} ne "''" && ($args{'OPERATOR'} !~/IS/ && $args{'VALUE'} !~ /^null$/i)) {
      33        
      33        
      66        
      66        
1124              
1125 87 100 66     364 unless ( $args{'CASESENSITIVE'} || !$args{'QUOTEVALUE'} ) {
1126             ( $QualifiedField, $args{'OPERATOR'}, $args{'VALUE'} ) =
1127             $self->_Handle->_MakeClauseCaseInsensitive( $QualifiedField,
1128 43         105 $args{'OPERATOR'}, $args{'VALUE'} );
1129             }
1130              
1131             }
1132              
1133             my $clause = {
1134             field => $QualifiedField,
1135             op => $args{'OPERATOR'},
1136 97         410 value => $args{'VALUE'},
1137             };
1138              
1139             # Juju because this should come _AFTER_ the EA
1140 97         177 my @prefix;
1141 97 100       260 if ( $self->{_open_parens}{ $ClauseId } ) {
1142 1         4 @prefix = ('(') x delete $self->{_open_parens}{ $ClauseId };
1143             }
1144              
1145 97 100 50     504 if ( lc( $args{'ENTRYAGGREGATOR'} || "" ) eq 'none' || !@$restriction ) {
      66        
1146 93         250 @$restriction = (@prefix, $clause);
1147             }
1148             else {
1149 4         17 push @$restriction, $args{'ENTRYAGGREGATOR'}, @prefix, $clause;
1150             }
1151              
1152 97         360 return ( $args{'ALIAS'} );
1153              
1154             }
1155              
1156              
1157             sub _OpenParen {
1158 1     1   12 my ($self, $clause) = @_;
1159 1         7 $self->{_open_parens}{ $clause }++;
1160             }
1161              
1162             # Immediate Action
1163             sub _CloseParen {
1164 1     1   14 my ( $self, $clause ) = @_;
1165 1   50     6 my $restriction = ($self->{'restrictions'}{ $clause } ||= []);
1166 1         6 push @$restriction, ')';
1167             }
1168              
1169              
1170             sub _AddSubClause {
1171 0     0   0 my $self = shift;
1172 0         0 my $clauseid = shift;
1173 0         0 my $subclause = shift;
1174              
1175 0         0 $self->{'subclauses'}{ $clauseid } = $subclause;
1176              
1177             }
1178              
1179              
1180              
1181             sub _WhereClause {
1182 159     159   322 my $self = shift;
1183              
1184             #Go through all the generic restrictions and build up the "generic_restrictions" subclause
1185             # That's the only one that SearchBuilder builds itself.
1186             # Arguably, the abstraction should be better, but I don't really see where to put it.
1187 159         440 $self->_CompileGenericRestrictions();
1188              
1189             #Go through all restriction types. Build the where clause from the
1190             #Various subclauses.
1191 159         297 my $where_clause = '';
1192 159         405 foreach my $subclause ( grep $_, sorted_values($self->{'subclauses'}) ) {
1193 150 50       336 $where_clause .= " AND " if $where_clause;
1194 150         356 $where_clause .= $subclause;
1195             }
1196              
1197 159 100       467 $where_clause = " WHERE " . $where_clause if $where_clause;
1198              
1199 159         495 return ($where_clause);
1200             }
1201              
1202              
1203             #Compile the restrictions to a WHERE Clause
1204              
1205             sub _CompileGenericRestrictions {
1206 159     159   251 my $self = shift;
1207              
1208 159         273 my $result = '';
1209             #Go through all the restrictions of this type. Buld up the generic subclause
1210 159         513 foreach my $restriction ( grep @$_, sorted_values($self->{'restrictions'}) ) {
1211 167 100       393 $result .= " AND " if $result;
1212 167         308 $result .= '(';
1213 167         308 foreach my $entry ( @$restriction ) {
1214 183 100       453 unless ( ref $entry ) {
1215 10         18 $result .= ' '. $entry . ' ';
1216             }
1217             else {
1218 173         331 $result .= join ' ', @{$entry}{qw(field op value)};
  173         563  
1219             }
1220             }
1221 167         321 $result .= ')';
1222             }
1223 159         476 return ($self->{'subclauses'}{'generic_restrictions'} = $result);
1224             }
1225              
1226              
1227             =head2 OrderBy PARAMHASH
1228              
1229             Orders the returned results by ALIAS.FIELD ORDER.
1230              
1231             Takes a paramhash of ALIAS, FIELD and ORDER.
1232             ALIAS defaults to C
.
1233             FIELD has no default value.
1234             ORDER defaults to ASC(ending). DESC(ending) is also a valid value for OrderBy.
1235              
1236             FIELD also accepts C format.
1237              
1238             =cut
1239              
1240             sub OrderBy {
1241 71     71 1 19479 my $self = shift;
1242 71         317 $self->OrderByCols( { @_ } );
1243             }
1244              
1245             =head2 OrderByCols ARRAY
1246              
1247             OrderByCols takes an array of paramhashes of the form passed to OrderBy.
1248             The result set is ordered by the items in the array.
1249              
1250             =cut
1251              
1252             sub OrderByCols {
1253 73     73 1 115 my $self = shift;
1254 73         188 my @args = @_;
1255              
1256 73         154 my $old_value = $self->_OrderClause;
1257 73         165 $self->{'order_by'} = \@args;
1258              
1259 73 100       134 if ( $self->_OrderClause ne $old_value ) {
1260 72         175 $self->RedoSearch();
1261             }
1262             }
1263              
1264             =head2 _OrderClause
1265              
1266             returns the ORDER BY clause for the search.
1267              
1268             =cut
1269              
1270             sub _OrderClause {
1271 441     441   625 my $self = shift;
1272              
1273 441 100       1218 return '' unless $self->{'order_by'};
1274              
1275 266         510 my $nulls_order = $self->_Handle->NullsOrder;
1276              
1277 266         452 my $clause = '';
1278 266         381 foreach my $row ( @{$self->{'order_by'}} ) {
  266         544  
1279              
1280 266         1047 my %rowhash = ( ALIAS => 'main',
1281             FIELD => undef,
1282             ORDER => 'ASC',
1283             %$row
1284             );
1285 266 100 66     1408 if ($rowhash{'ORDER'} && $rowhash{'ORDER'} =~ /^des/i) {
1286 116         247 $rowhash{'ORDER'} = "DESC";
1287 116 50       242 $rowhash{'ORDER'} .= ' '. $nulls_order->{'DESC'} if $nulls_order;
1288             }
1289             else {
1290 150         277 $rowhash{'ORDER'} = "ASC";
1291 150 50       299 $rowhash{'ORDER'} .= ' '. $nulls_order->{'ASC'} if $nulls_order;
1292             }
1293 266 50       552 $rowhash{'ALIAS'} = 'main' unless defined $rowhash{'ALIAS'};
1294              
1295 266 50 33     1117 if ( defined $rowhash{'ALIAS'} and
      33        
1296             $rowhash{'FIELD'} and
1297             $rowhash{'ORDER'} ) {
1298              
1299 266 100 66     1126 if ( length $rowhash{'ALIAS'} && $rowhash{'FIELD'} =~ /^(.*\()(.*\))$/ ) {
1300             # handle 'FUNCTION(FIELD)' formatted fields
1301 72         216 $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
1302 72         163 $rowhash{'FIELD'} = $2;
1303             }
1304              
1305 266 50       594 $clause .= ($clause ? ", " : " ");
1306 266 50       674 $clause .= $rowhash{'ALIAS'} . "." if length $rowhash{'ALIAS'};
1307 266         423 $clause .= $rowhash{'FIELD'} . " ";
1308 266         631 $clause .= $rowhash{'ORDER'};
1309             }
1310             }
1311 266 50       715 $clause = " ORDER BY$clause " if $clause;
1312              
1313 266         1084 return $clause;
1314             }
1315              
1316             =head2 GroupByCols ARRAY_OF_HASHES
1317              
1318             Each hash contains the keys FIELD, FUNCTION and ALIAS. Hash
1319             combined into SQL with L.
1320              
1321             =cut
1322              
1323             sub GroupByCols {
1324 5     5 1 18 my $self = shift;
1325 5         14 my @args = @_;
1326              
1327 5         13 my $old_value = $self->_GroupClause;
1328 5         12 $self->{'group_by'} = \@args;
1329              
1330 5 50       10 if ( $self->_GroupClause ne $old_value ) {
1331 5         13 $self->RedoSearch();
1332             }
1333             }
1334              
1335             =head2 _GroupClause
1336              
1337             Private function to return the "GROUP BY" clause for this query.
1338              
1339             =cut
1340              
1341             sub _GroupClause {
1342 272     272   459 my $self = shift;
1343 272 100       1238 return '' unless $self->{'group_by'};
1344              
1345 42         75 my $clause = '';
1346 42         65 foreach my $row ( @{$self->{'group_by'}} ) {
  42         89  
1347 42 50       129 my $part = $self->CombineFunctionWithField( %$row )
1348             or next;
1349              
1350 42 50       94 $clause .= ', ' if $clause;
1351 42         84 $clause .= $part;
1352             }
1353              
1354 42 50       88 return '' unless $clause;
1355 42         137 return " GROUP BY $clause ";
1356             }
1357              
1358             =head2 NewAlias
1359              
1360             Takes the name of a table and paramhash with TYPE and DISTINCT.
1361              
1362             Use TYPE equal to C to indicate that it's LEFT JOIN. Old
1363             style way to call (see below) is also supported, but should be
1364             B:
1365              
1366             $records->NewAlias('aTable', 'left');
1367              
1368             True DISTINCT value indicates that this join keeps result set
1369             distinct and DB side distinct is not required. See also L.
1370              
1371             Returns the string of a new Alias for that table, which can be used to Join tables
1372             or to Limit what gets found by a search.
1373              
1374             =cut
1375              
1376             sub NewAlias {
1377 6     6 1 34 my $self = shift;
1378 6   50     18 my $table = shift || die "Missing parameter";
1379 6 50       30 my %args = @_%2? (TYPE => @_) : (@_);
1380              
1381 6         13 my $type = $args{'TYPE'};
1382              
1383 6         16 my $alias = $self->_GetAlias($table);
1384              
1385 6 50       21 $table = $self->_Handle->QuoteName($table) if $self->_Handle->QuoteTableNames;
1386 6 0       18 unless ( $type ) {
    50          
1387 6         10 push @{ $self->{'aliases'} }, "$table $alias";
  6         51  
1388 0         0 } elsif ( lc $type eq 'left' ) {
1389 0   0     0 my $meta = $self->{'left_joins'}{"$alias"} ||= {};
1390 0         0 $meta->{'alias_string'} = " LEFT JOIN $table $alias ";
1391 0         0 $meta->{'type'} = 'LEFT';
1392 0         0 $meta->{'depends_on'} = '';
1393             } else {
1394 0         0 die "Unsupported alias(join) type";
1395             }
1396              
1397 6 100 66     36 if ( $args{'DISTINCT'} && !defined $self->{'joins_are_distinct'} ) {
    50          
1398 1         3 $self->{'joins_are_distinct'} = 1;
1399             } elsif ( !$args{'DISTINCT'} ) {
1400 5         12 $self->{'joins_are_distinct'} = 0;
1401             }
1402              
1403 6         26 return $alias;
1404             }
1405              
1406              
1407              
1408             # _GetAlias is a private function which takes an tablename and
1409             # returns a new alias for that table without adding something
1410             # to self->{'aliases'}. This function is used by NewAlias
1411             # and the as-yet-unnamed left join code
1412              
1413             sub _GetAlias {
1414 90     90   168 my $self = shift;
1415 90         152 my $table = shift;
1416              
1417 90         165 $self->{'alias_count'}++;
1418 90         289 my $alias = $table . "_" . $self->{'alias_count'};
1419              
1420 90         224 return ($alias);
1421              
1422             }
1423              
1424              
1425              
1426             =head2 Join
1427              
1428             Join instructs DBIx::SearchBuilder to join two tables.
1429              
1430             The standard form takes a param hash with keys ALIAS1, FIELD1, ALIAS2 and
1431             FIELD2. ALIAS1 and ALIAS2 are column aliases obtained from $self->NewAlias or
1432             a $self->Limit. FIELD1 and FIELD2 are the fields in ALIAS1 and ALIAS2 that
1433             should be linked, respectively. For this type of join, this method
1434             has no return value.
1435              
1436             Supplying the parameter TYPE => 'left' causes Join to preform a left join.
1437             in this case, it takes ALIAS1, FIELD1, TABLE2 and FIELD2. Because of the way
1438             that left joins work, this method needs a TABLE for the second field
1439             rather than merely an alias. For this type of join, it will return
1440             the alias generated by the join.
1441              
1442             Instead of ALIAS1/FIELD1, it's possible to specify EXPRESSION, to join
1443             ALIAS2/TABLE2 on an arbitrary expression.
1444              
1445             It is also possible to join to a pre-existing, already-limited
1446             L object, by passing it as COLLECTION2, instead
1447             of providing an ALIAS2 or TABLE2.
1448              
1449             By passing true value as DISTINCT argument join can be marked distinct. If
1450             all joins are distinct then whole query is distinct and SearchBuilder can
1451             avoid L call that can hurt performance of the query. See
1452             also L.
1453              
1454             =cut
1455              
1456             sub Join {
1457 88     88 1 921 my $self = shift;
1458 88         580 my %args = (
1459             TYPE => 'normal',
1460             FIELD1 => undef,
1461             ALIAS1 => 'main',
1462             TABLE2 => undef,
1463             COLLECTION2 => undef,
1464             FIELD2 => undef,
1465             ALIAS2 => undef,
1466             @_
1467             );
1468              
1469 88         197 $self->_Handle->Join( SearchBuilder => $self, %args );
1470              
1471             }
1472              
1473             =head2 Pages: size and changing
1474              
1475             Use L to set size of pages. L,
1476             L, L or L to change
1477             pages. L to do tricky stuff.
1478              
1479             =head3 RowsPerPage
1480              
1481             Get or set the number of rows returned by the database.
1482              
1483             Takes an optional integer which restricts the # of rows returned
1484             in a result. Zero or undef argument flush back to "return all
1485             records matching current conditions".
1486              
1487             Returns the current page size.
1488              
1489             =cut
1490              
1491             sub RowsPerPage {
1492 429     429 1 760 my $self = shift;
1493              
1494 429 100 100     1112 if ( @_ && ($_[0]||0) != $self->{'show_rows'} ) {
      100        
1495 37   50     94 $self->{'show_rows'} = shift || 0;
1496 37         71 $self->RedoSearch;
1497             }
1498              
1499 429         1181 return ( $self->{'show_rows'} );
1500             }
1501              
1502             =head3 NextPage
1503              
1504             Turns one page forward.
1505              
1506             =cut
1507              
1508             sub NextPage {
1509 8     8 1 1098 my $self = shift;
1510 8         34 $self->FirstRow( $self->FirstRow + 1 + $self->RowsPerPage );
1511             }
1512              
1513             =head3 PrevPage
1514              
1515             Turns one page backwards.
1516              
1517             =cut
1518              
1519             sub PrevPage {
1520 3     3 1 4 my $self = shift;
1521 3 100       9 if ( ( $self->FirstRow - $self->RowsPerPage ) > 0 ) {
1522 2         9 $self->FirstRow( 1 + $self->FirstRow - $self->RowsPerPage );
1523             }
1524             else {
1525 1         3 $self->FirstRow(1);
1526             }
1527             }
1528              
1529             =head3 FirstPage
1530              
1531             Jumps to the first page.
1532              
1533             =cut
1534              
1535             sub FirstPage {
1536 0     0 1 0 my $self = shift;
1537 0         0 $self->FirstRow(1);
1538             }
1539              
1540             =head3 GotoPage
1541              
1542             Takes an integer number and jumps to that page or first page if
1543             number omitted. Numbering starts from zero.
1544              
1545             =cut
1546              
1547             sub GotoPage {
1548 33     33 1 140 my $self = shift;
1549 33   50     76 my $page = shift || 0;
1550              
1551 33         72 $self->FirstRow( 1 + $self->RowsPerPage * $page );
1552             }
1553              
1554             =head3 FirstRow
1555              
1556             Get or set the first row of the result set the database should return.
1557             Takes an optional single integer argrument. Returns the currently set integer
1558             minus one (this is historical issue).
1559              
1560             Usually you don't need this method. Use L, L and other
1561             methods to walk pages. It only may be helpful to get 10 records starting from
1562             5th.
1563              
1564             =cut
1565              
1566             sub FirstRow {
1567 240     240 1 393 my $self = shift;
1568 240 100 50     710 if (@_ && ($_[0]||1) != ($self->{'first_row'}+1) ) {
      100        
1569 29         56 $self->{'first_row'} = shift;
1570              
1571             #SQL starts counting at 0
1572 29         44 $self->{'first_row'}--;
1573              
1574             #gotta redo the search if changing pages
1575 29         59 $self->RedoSearch();
1576             }
1577 240         852 return ( $self->{'first_row'} );
1578             }
1579              
1580              
1581             =head2 _ItemsCounter
1582              
1583             Returns the current position in the record set.
1584              
1585             =cut
1586              
1587             sub _ItemsCounter {
1588 5     5   9 my $self = shift;
1589 5         12 return $self->{'itemscount'};
1590             }
1591              
1592              
1593             =head2 Count
1594              
1595             Returns the number of records in the set. When L is set,
1596             returns number of records in the page only, otherwise the same as
1597             L.
1598              
1599             =cut
1600              
1601             sub Count {
1602 69     69 1 553 my $self = shift;
1603              
1604             # An unlimited search returns no tickets
1605 69 100       161 return 0 unless ($self->_isLimited);
1606              
1607 62 100       181 if ( $self->{'must_redo_search'} ) {
1608 47 100       175 if ( $self->RowsPerPage ) {
1609 2         28 $self->_DoSearch;
1610             }
1611             else {
1612             # No RowsPerPage means Count == CountAll
1613 45         136 return $self->CountAll;
1614             }
1615             }
1616              
1617 17         66 return $self->_RecordCount;
1618             }
1619              
1620              
1621              
1622             =head2 CountAll
1623              
1624             Returns the total number of potential records in the set, ignoring any
1625             L settings.
1626              
1627             =cut
1628              
1629             sub CountAll {
1630 112     112 1 32463 my $self = shift;
1631              
1632             # An unlimited search returns no tickets
1633 112 50       272 return 0 unless ($self->_isLimited);
1634              
1635             # If we haven't actually got all objects loaded in memory, we
1636             # really just want to do a quick count from the database.
1637             # or if we have paging enabled then we count as well and store it in count_all
1638 112 100 100     379 if ( $self->{'must_redo_search'} || ( $self->RowsPerPage && !$self->{'count_all'} ) ) {
    100 100        
1639             # If we haven't already asked the database for the row count, do that
1640 62         230 $self->_DoCount;
1641              
1642             #Report back the raw # of rows in the database
1643 62         440 return ( $self->{'count_all'} );
1644             }
1645              
1646             # if we have paging enabled and have count_all then return it
1647             elsif ( $self->RowsPerPage ) {
1648 17         43 return ( $self->{'count_all'} );
1649             }
1650              
1651             # If we have loaded everything from the DB we have an
1652             # accurate count already.
1653             else {
1654 33         80 return $self->_RecordCount;
1655             }
1656             }
1657              
1658              
1659             =head2 IsLast
1660              
1661             Returns true if the current row is the last record in the set.
1662              
1663             =cut
1664              
1665             sub IsLast {
1666 9     9 1 1471 my $self = shift;
1667              
1668 9 100       21 return undef unless $self->Count;
1669              
1670 5 100       18 if ( $self->_ItemsCounter == $self->Count ) {
1671 3         17 return (1);
1672             }
1673             else {
1674 2         13 return (0);
1675             }
1676             }
1677              
1678              
1679             =head2 Column
1680              
1681             Call to specify which columns should be loaded from the table. Each
1682             calls adds one column to the set. Takes a hash with the following named
1683             arguments:
1684              
1685             =over 4
1686              
1687             =item FIELD
1688              
1689             Column name to fetch or apply function to.
1690              
1691             =item ALIAS
1692              
1693             Alias of a table the field is in; defaults to C
1694              
1695             =item FUNCTION
1696              
1697             A SQL function that should be selected instead of FIELD or applied to it.
1698              
1699             =item AS
1700              
1701             The B alias to use instead of the default. The default column alias is
1702             either the column's name (i.e. what is passed to FIELD) if it is in this table
1703             (ALIAS is 'main') or an autogenerated alias. Pass C to skip column
1704             aliasing entirely.
1705              
1706             =back
1707              
1708             C, C and C are combined according to
1709             L.
1710              
1711             If a FIELD is provided and it is in this table (ALIAS is 'main'), then
1712             the column named FIELD and can be accessed as usual by accessors:
1713              
1714             $articles->Column(FIELD => 'id');
1715             $articles->Column(FIELD => 'Subject', FUNCTION => 'SUBSTR(?, 1, 20)');
1716             my $article = $articles->First;
1717             my $aid = $article->id;
1718             my $subject_prefix = $article->Subject;
1719              
1720             Returns the alias used for the column. If FIELD was not provided, or was
1721             from another table, then the returned column alias should be passed to
1722             the L method to retrieve the
1723             column's result:
1724              
1725             my $time_alias = $articles->Column(FUNCTION => 'NOW()');
1726             my $article = $articles->First;
1727             my $now = $article->_Value( $time_alias );
1728              
1729             To choose the column's alias yourself, pass a value for the AS parameter (see
1730             above). Be careful not to conflict with existing column aliases.
1731              
1732             =cut
1733              
1734             sub Column {
1735 68     68 1 257 my $self = shift;
1736 68         282 my %args = ( TABLE => undef,
1737             ALIAS => undef,
1738             FIELD => undef,
1739             FUNCTION => undef,
1740             @_);
1741              
1742 68   100     274 $args{'ALIAS'} ||= 'main';
1743              
1744 68   50     204 my $name = $self->CombineFunctionWithField( %args ) || 'NULL';
1745              
1746 68         140 my $column = $args{'AS'};
1747              
1748 68 100 100     244 if (not defined $column and not exists $args{'AS'}) {
1749 64 100 100     363 if (
      33        
      66        
1750             $args{FIELD} && $args{ALIAS} eq 'main'
1751             && (!$args{'TABLE'} || $args{'TABLE'} eq $self->Table )
1752             ) {
1753 60         111 $column = $args{FIELD};
1754              
1755             # make sure we don't fetch columns with duplicate aliases
1756 60 100       148 if ( $self->{columns} ) {
1757 24         54 my $suffix = " AS \L$column";
1758 24 100       38 if ( grep index($_, $suffix, -length $suffix) >= 0, @{ $self->{columns} } ) {
  24         144  
1759 21         34 $column .= scalar @{ $self->{columns} };
  21         48  
1760             }
1761             }
1762             }
1763             else {
1764 4   50     9 $column = "col" . @{ $self->{columns} ||= [] };
  4         19  
1765             }
1766             }
1767 68 100 100     109 push @{ $self->{columns} ||= [] }, defined($column) ? "$name AS \L$column" : $name;
  68         356  
1768 68         260 return $column;
1769             }
1770              
1771             =head2 CombineFunctionWithField
1772              
1773             Takes a hash with three optional arguments: FUNCTION, FIELD and ALIAS.
1774              
1775             Returns SQL with all three arguments combined according to the following
1776             rules.
1777              
1778             =over 4
1779              
1780             =item *
1781              
1782             FUNCTION or undef returned when FIELD is not provided
1783              
1784             =item *
1785              
1786             'main' ALIAS is used if not provided
1787              
1788             =item *
1789              
1790             ALIAS.FIELD returned when FUNCTION is not provided
1791              
1792             =item *
1793              
1794             NULL returned if FUNCTION is 'NULL'
1795              
1796             =item *
1797              
1798             If FUNCTION contains '?' (question marks) then they are replaced with
1799             ALIAS.FIELD and result returned.
1800              
1801             =item *
1802              
1803             If FUNCTION has no '(' (opening parenthesis) then ALIAS.FIELD is
1804             appended in parentheses and returned.
1805              
1806             =back
1807              
1808             Examples:
1809              
1810             $obj->CombineFunctionWithField()
1811             => undef
1812              
1813             $obj->CombineFunctionWithField(FUNCTION => 'FOO')
1814             => 'FOO'
1815              
1816             $obj->CombineFunctionWithField(FIELD => 'foo')
1817             => 'main.foo'
1818              
1819             $obj->CombineFunctionWithField(ALIAS => 'bar', FIELD => 'foo')
1820             => 'bar.foo'
1821              
1822             $obj->CombineFunctionWithField(FUNCTION => 'FOO(?, ?)', FIELD => 'bar')
1823             => 'FOO(main.bar, main.bar)'
1824              
1825             $obj->CombineFunctionWithField(FUNCTION => 'FOO', ALIAS => 'bar', FIELD => 'baz')
1826             => 'FOO(bar.baz)'
1827              
1828             $obj->CombineFunctionWithField(FUNCTION => 'NULL', FIELD => 'bar')
1829             => 'NULL'
1830              
1831             =cut
1832              
1833              
1834              
1835             sub CombineFunctionWithField {
1836 209     209 1 326 my $self = shift;
1837 209         860 my %args = (
1838             FUNCTION => undef,
1839             ALIAS => undef,
1840             FIELD => undef,
1841             @_
1842             );
1843              
1844 209 100       550 unless ( $args{'FIELD'} ) {
1845 9   50     43 return $args{'FUNCTION'} || undef;
1846             }
1847              
1848 200   100     671 my $field = ($args{'ALIAS'} || 'main') .'.'. $args{'FIELD'};
1849 200 100       790 return $field unless $args{'FUNCTION'};
1850              
1851 31         59 my $func = $args{'FUNCTION'};
1852 31 50 100     216 if ( $func =~ /^DISTINCT\s*COUNT$/i ) {
    100          
    100          
1853 0         0 $func = "COUNT(DISTINCT $field)";
1854             }
1855              
1856             # If we want to substitute
1857             elsif ( $func =~ s/\?/$field/g ) {
1858             # no need to do anything, we already replaced
1859             }
1860              
1861             # If we want to call a simple function on the column
1862             elsif ( $func !~ /\(/ && lc($func) ne 'null' ) {
1863 1         7 $func = "\U$func\E($field)";
1864             }
1865              
1866 31         111 return $func;
1867             }
1868              
1869              
1870              
1871              
1872             =head2 Columns LIST
1873              
1874             Specify that we want to load only the columns in LIST
1875              
1876             =cut
1877              
1878             sub Columns {
1879 0     0 1 0 my $self = shift;
1880 0         0 $self->Column( FIELD => $_ ) for @_;
1881             }
1882              
1883             =head2 AdditionalColumn
1884              
1885             Calls L, but first ensures that this table's standard columns are
1886             selected as well. Thus, each call to this method results in an additional
1887             column selected instead of replacing the default columns.
1888              
1889             Takes a hash of parameters which is the same as L. Returns the result
1890             of calling L.
1891              
1892             =cut
1893              
1894             sub AdditionalColumn {
1895 1     1 1 19 my $self = shift;
1896             $self->Column( FUNCTION => "main.*", AS => undef )
1897 1 50       2 unless grep { /^\Qmain.*\E$/ } @{$self->{columns}};
  0         0  
  1         8  
1898 1         8 return $self->Column(@_);
1899             }
1900              
1901             =head2 Fields TABLE
1902              
1903             Return a list of fields in TABLE. These fields are in the case
1904             presented by the database, which may be case-sensitive.
1905              
1906             =cut
1907              
1908             sub Fields {
1909 0     0 1 0 return (shift)->_Handle->Fields( @_ );
1910             }
1911              
1912              
1913             =head2 HasField { TABLE => undef, FIELD => undef }
1914              
1915             Returns true if TABLE has field FIELD.
1916             Return false otherwise
1917              
1918             Note: Both TABLE and FIELD are case-sensitive (See: L)
1919              
1920             =cut
1921              
1922             sub HasField {
1923 0     0 1 0 my $self = shift;
1924 0         0 my %args = ( FIELD => undef,
1925             TABLE => undef,
1926             @_);
1927              
1928 0 0       0 my $table = $args{TABLE} or die;
1929 0 0       0 my $field = $args{FIELD} or die;
1930 0         0 return grep { $_ eq $field } $self->Fields($table);
  0         0  
1931             }
1932              
1933              
1934             =head2 Table [TABLE]
1935              
1936             If called with an argument, sets this collection's table.
1937              
1938             Always returns this collection's table.
1939              
1940             =cut
1941              
1942             sub Table {
1943 594     594 1 1262 my $self = shift;
1944 594 100       1353 $self->{table} = shift if (@_);
1945 594         2327 return $self->{table};
1946             }
1947              
1948             =head2 QueryHint [Hint]
1949              
1950             If called with an argument, sets a query hint for this collection.
1951              
1952             Always returns the query hint.
1953              
1954             When the query hint is included in the SQL query, the C will be
1955             included for you. Here's an example query hint for Oracle:
1956              
1957             $sb->QueryHint("+CURSOR_SHARING_EXACT");
1958              
1959             =cut
1960              
1961             sub QueryHint {
1962 275     275 1 424 my $self = shift;
1963 275 50       556 $self->{query_hint} = shift if (@_);
1964 275         508 return $self->{query_hint};
1965             }
1966              
1967             =head2 QueryHintFormatted
1968              
1969             Returns the query hint formatted appropriately for inclusion in SQL queries.
1970              
1971             =cut
1972              
1973             sub QueryHintFormatted {
1974 227     227 1 414 my $self = shift;
1975 227         475 my $QueryHint = $self->QueryHint;
1976 227 50       587 return $QueryHint ? " /* $QueryHint */ " : " ";
1977             }
1978              
1979              
1980             sub _OptimizeQuery {
1981 252     252   411 my $self = shift;
1982 252         382 my $query = shift;
1983              
1984 252   66     1181 my %args = ( PreferBind => $self->{_prefer_bind} // $PREFER_BIND, @_ );
1985              
1986 252         550 undef $self->{_bind_values};
1987 252 100       650 if ( $args{PreferBind} ) {
1988 32         67 ( $$query, my @bind_values ) = $self->_Handle->_ExtractBindValues($$query);
1989              
1990             # Set _bind_values even if no values are extracted, as we use it in
1991             # ApplyLimits to determine if bind is enabled.
1992 32         117 $self->{_bind_values} = \@bind_values;
1993             }
1994             }
1995              
1996             =head1 DEPRECATED METHODS
1997              
1998             =head2 GroupBy
1999              
2000             DEPRECATED. Alias for the L method.
2001              
2002             =cut
2003              
2004 4     4 1 51 sub GroupBy { (shift)->GroupByCols( @_ ) }
2005              
2006             =head2 SetTable
2007              
2008             DEPRECATED. Alias for the L
method. 2009               2010             =cut 2011               2012             sub SetTable { 2013 0     0 1   my $self = shift; 2014 0           return $self->Table(@_); 2015             } 2016               2017             =head2 ShowRestrictions 2018               2019             DEPRECATED AND DOES NOTHING. 2020               2021             =cut 2022               2023       0 1   sub ShowRestrictions { } 2024               2025             =head2 ImportRestrictions 2026               2027             DEPRECATED AND DOES NOTHING. 2028               2029             =cut 2030               2031       0 1   sub ImportRestrictions { } 2032               2033             # not even documented 2034 0     0 0   sub DEBUG { warn "DEBUG is deprecated" } 2035               2036               2037             if( eval { require capitalization } ) { 2038             capitalization->unimport( __PACKAGE__ ); 2039             } 2040               2041             1; 2042             __END__