File Coverage

blib/lib/Class/DBI/Search/Basic.pm
Criterion Covered Total %
statement 55 55 100.0
branch 8 8 100.0
condition 9 18 50.0
subroutine 14 14 100.0
pod 6 6 100.0
total 92 101 91.1


line stmt bran cond sub pod time code
1             package Class::DBI::Search::Basic;
2              
3             =head1 NAME
4            
5             Class::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            
24             This is the start of a pluggable Search infrastructure for Class::DBI.
25            
26             At the minute Class::DBI::Search::Basic doubles up as both the default
27             search within Class::DBI as well as the search base class. We will
28             probably need to tease this apart more later and create an abstract base
29             class 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            
39             A Searcher is created with the class to which the results will belong,
40             and the arguments passed to the search call by the user.
41            
42             =head2 opt
43            
44             if (my $order = $self->opt('order_by')) { ... }
45            
46             The arguments passed to search may contain an options hash. This will
47             return 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            
54             Actually run the search.
55            
56             =head1 SUBCLASSING
57            
58             =head2 sql / bind / fragment
59            
60             The actual mechanics of generating the SQL and executing it split up
61             into a variety of methods for you to override.
62            
63             run_search() is implemented as:
64            
65             return $cdbi->sth_to_objects($self->sql, $self->bind);
66            
67             Where sql() is
68            
69             $cdbi->sql_Retrieve($self->fragment);
70            
71            
72             There are also a variety of private methods underneath this that could
73             be overriden in a pinch, but if you need to do this I'd rather you let
74             me know so that I can make them public, or at least so that I don't
75             remove them from under your feet.
76            
77             =cut
78              
79 25     25   342 use strict;
  25         1196  
  25         756  
80 25     25   408 use warnings;
  25         253  
  25         552  
81              
82 25     25   2288 use base 'Class::Accessor::Fast';
  25         272  
  25         459  
83             __PACKAGE__->mk_accessors(qw/class args opts type/);
84              
85             sub new {
86 106     106 1 1222 my ($me, $proto, @args) = @_;
87 106         4334 my ($args, $opts) = $me->_unpack_args(@args);
88 106   66     7028 bless {
89             class => ref $proto || $proto,
90             args  => $args,
91             opts  => $opts,
92             type  => "=",
93             } => $me;
94             }
95              
96             sub opt {
97 106     106 1 1400 my ($self, $option) = @_;
98 106         1508 $self->{opts}->{$option};
99             }
100              
101             sub _unpack_args {
102 106     106   1156 my ($self, @args) = @_;
103 106 100       3687 @args = %{ $args[0] } if ref $args[0] eq "HASH";
  4         65  
104 106 100       3507 my $opts = @args % 2 ? pop @args : {};
105 106         2324 return (\@args, $opts);
106             }
107              
108             sub _search_for {
109 106     106   1208 my $self = shift;
110 106         2784 my @args = @{ $self->{args} };
  106         1320  
111 106         1026 my $class = $self->{class};
112 106         5659 my %search_for;
113 106         1714 while (my ($col, $val) = splice @args, 0, 2) {
114             my $column = $class->find_column($col)
115 117   66 4   3490 || (List::Util::first { $_->accessor eq $col } $class->columns)
  4   33     55  
116             || $class->_croak("$col is not a column of $class");
117 117         12035 $search_for{$column} = $class->_deflated_column($column, $val);
118             }
119 106         5674 return \%search_for;
120             }
121              
122             sub _qual_bind {
123 211     211   2169 my $self = shift;
124 211   66     5658 $self->{_qual_bind} ||= do {
125 106         1079 my $search_for = $self->_search_for;
126 106         1313 my $type = $self->type;
127 106         2028 my (@qual, @bind);
128 106         1636 for my $column (sort keys %$search_for) { # sort for prepare_cached
129 117 100       1631 if (defined(my $value = $search_for->{$column})) {
130 116         2955 push @qual, "$column $type ?";
131 116         1340 push @bind, $value;
132             } else {
133              
134             # perhaps _carp if $type ne "="
135 1         13 push @qual, "$column IS NULL";
136             }
137             }
138 106         9437 [ \@qual, \@bind ];
139             };
140             }
141              
142             sub _qual {
143 106     106   2573 my $self = shift;
144 106   33     1529 $self->{_qual} ||= $self->_qual_bind->[0];
145             }
146              
147             sub bind {
148 105     105 1 6852 my $self = shift;
149 105   33     1749 $self->{_bind} ||= $self->_qual_bind->[1];
150             }
151              
152             sub fragment {
153 106     106 1 2026 my $self = shift;
154 106         1089 my $frag = join " AND ", @{ $self->_qual };
  106         3885  
155 106 100       2138 if (my $order = $self->opt('order_by')) {
156 8         83 $frag .= " ORDER BY $order";
157             }
158 106         2248 return $frag;
159             }
160              
161             sub sql {
162 106     106 1 1612 my $self = shift;
163 106         1330 return $self->class->sql_Retrieve($self->fragment);
164             }
165              
166             sub run_search {
167 106     106 1 1729 my $self = shift;
168 106         1334 my $cdbi = $self->class;
169 106         14291 return $cdbi->sth_to_objects($self->sql, $self->bind);
170             }
171              
172             1;
173