File Coverage

blib/lib/DBIx/SearchBuilder.pm
Criterion Covered Total %
statement 458 505 90.6
branch 185 234 79.0
condition 87 132 65.9
subroutine 69 80 86.2
pod 46 47 97.8
total 845 998 84.6


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