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