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