1package Class::DBI::Search::Basic; 2 3=head1 NAME 4 5Class::DBI::Search::Basic - Simple Class::DBI search 6 7=head1 SYNOPSIS 8 9 my $searcher = Class::DBI::Search::Basic->new( 10 $cdbi_class, @search_args 11 ); 12 13 my @results = $searcher->run_search; 14 15 # Over in your Class::DBI subclass: 16 17 __PACKAGE__->add_searcher( 18 search => "Class::DBI::Search::Basic", 19 isearch => "Class::DBI::Search::Plugin::CaseInsensitive", 20 ); 21 22=head1 DESCRIPTION 23 24This is the start of a pluggable Search infrastructure for Class::DBI. 25 26At the minute Class::DBI::Search::Basic doubles up as both the default 27search within Class::DBI as well as the search base class. We will 28probably need to tease this apart more later and create an abstract base 29class for search plugins. 30 31=head1 METHODS 32 33=head2 new 34 35 my $searcher = Class::DBI::Search::Basic->new( 36 $cdbi_class, @search_args 37 ); 38 39A Searcher is created with the class to which the results will belong, 40and the arguments passed to the search call by the user. 41 42=head2 opt 43 44 if (my $order = $self->opt('order_by')) { ... } 45 46The arguments passed to search may contain an options hash. This will 47return the value of a given option. 48 49=head2 run_search 50 51 my @results = $searcher->run_search; 52 my $iterator = $searcher->run_search; 53 54Actually run the search. 55 56=head1 SUBCLASSING 57 58=head2 sql / bind / fragment 59 60The actual mechanics of generating the SQL and executing it split up 61into a variety of methods for you to override. 62 63run_search() is implemented as: 64 65 return $cdbi->sth_to_objects($self->sql, $self->bind); 66 67Where sql() is 68 69 $cdbi->sql_Retrieve($self->fragment); 70 71 72There are also a variety of private methods underneath this that could 73be overriden in a pinch, but if you need to do this I'd rather you let 74me know so that I can make them public, or at least so that I don't 75remove them from under your feet. 76 77=cut 78 79use strict; 80use warnings; 81 82use base 'Class::Accessor::Fast'; 83__PACKAGE__->mk_accessors(qw/class args opts type/); 84 85sub new { 86 my ($me, $proto, @args) = @_; 87 my ($args, $opts) = $me->_unpack_args(@args); 88 bless { 89 class => ref $proto || $proto, 90 args => $args, 91 opts => $opts, 92 type => "=", 93 } => $me; 94} 95 96sub opt { 97 my ($self, $option) = @_; 98 $self->{opts}->{$option}; 99} 100 101sub _unpack_args { 102 my ($self, @args) = @_; 103 @args = %{ $args[0] } if ref $args[0] eq "HASH"; 104 my $opts = @args % 2 ? pop @args : {}; 105 return (\@args, $opts); 106} 107 108sub _search_for { 109 my $self = shift; 110 my @args = @{ $self->{args} }; 111 my $class = $self->{class}; 112 my %search_for; 113 while (my ($col, $val) = splice @args, 0, 2) { 114 my $column = $class->find_column($col) 115 || (List::Util::first { $_->accessor eq $col } $class->columns) 116 || $class->_croak("$col is not a column of $class"); 117 $search_for{$column} = $class->_deflated_column($column, $val); 118 } 119 return \%search_for; 120} 121 122sub _qual_bind { 123 my $self = shift; 124 $self->{_qual_bind} ||= do { 125 my $search_for = $self->_search_for; 126 my $type = $self->type; 127 my (@qual, @bind); 128 for my $column (sort keys %$search_for) { # sort for prepare_cached 129 if (defined(my $value = $search_for->{$column})) { 130 push @qual, "$column $type ?"; 131 push @bind, $value; 132 } else { 133 134 # perhaps _carp if $type ne "=" 135 push @qual, "$column IS NULL"; 136 } 137 } 138 [ \@qual, \@bind ]; 139 }; 140} 141 142sub _qual { 143 my $self = shift; 144 $self->{_qual} ||= $self->_qual_bind->[0]; 145} 146 147sub bind { 148 my $self = shift; 149 $self->{_bind} ||= $self->_qual_bind->[1]; 150} 151 152sub fragment { 153 my $self = shift; 154 my $frag = join " AND ", @{ $self->_qual }; 155 if (my $order = $self->opt('order_by')) { 156 $frag .= " ORDER BY $order"; 157 } 158 return $frag; 159} 160 161sub sql { 162 my $self = shift; 163 return $self->class->sql_Retrieve($self->fragment); 164} 165 166sub run_search { 167 my $self = shift; 168 my $cdbi = $self->class; 169 return $cdbi->sth_to_objects($self->sql, $self->bind); 170} 171 1721; 173