File Coverage

blib/lib/DBIx/SearchBuilder.pm
Criterion Covered Total %
statement 455 502 90.6
branch 182 234 77.7
condition 82 129 63.5
subroutine 68 79 86.0
pod 46 47 97.8
total 833 991 84.0


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