File Coverage

blib/lib/DBIx/SearchBuilder.pm
Criterion Covered Total %
statement 458 505 90.6
branch 183 234 78.2
condition 87 132 65.9
subroutine 69 80 86.2
pod 46 47 97.8
total 843 998 84.4


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