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