1package Class::DBI::Query::Base;
2
3use strict;
4
5use base 'Class::Accessor';
6use Storable 'dclone';
7
8sub new {
9	my ($class, $fields) = @_;
10	my $self = $class->SUPER::new();
11	foreach my $key (keys %{ $fields || {} }) {
12		$self->set($key => $fields->{$key});
13	}
14	$self;
15}
16
17sub get {
18	my ($self, $key) = @_;
19	my @vals = @{ $self->{$key} || [] };
20	return wantarray ? @vals : $vals[0];
21}
22
23sub set {
24	my ($self, $key, @args) = @_;
25	@args = map { ref $_ eq "ARRAY" ? @$_ : $_ } @args;
26	$self->{$key} = [@args];
27}
28
29sub clone { dclone shift }
30
31package Class::DBI::Query;
32
33use base 'Class::DBI::Query::Base';
34
35__PACKAGE__->mk_accessors(
36	qw/
37		owner essential sqlname where_clause restrictions order_by kings
38		/
39);
40
41=head1 NAME
42
43Class::DBI::Query - Deprecated SQL manager for Class::DBI
44
45=head1 SYNOPSIS
46
47	my $sth = Class::DBI::Query
48		->new({
49			owner => $class,
50			sqlname => $type,
51			essential => \@columns,
52			where_columns => \@where_cols,
53		})
54		->run($val);
55
56
57=head1 DESCRIPTION
58
59This abstracts away many of the details of the Class::DBI underlying SQL
60mechanism. For the most part you probably don't want to be interfacing
61directly with this.
62
63The underlying mechanisms are not yet stable, and are subject to change
64at any time.
65
66=cut
67
68=head1 OPTIONS
69
70A Query can have many options set before executing. Most can either be
71passed as an option to new(), or set later if you are building the query
72up dynamically:
73
74=head2 owner
75
76The Class::DBI subclass that 'owns' this query. In the vast majority
77of cases a query will return objects - the owner is the class of
78which instances will be returned.
79
80=head2 sqlname
81
82This should be the name of a query set up using set_sql.
83
84=head2 where_clause
85
86This is the raw SQL that will substituted into the 'WHERE %s' in your
87query. If you have multiple %s's in your query then you should supply
88a listref of where_clauses. This SQL can include placeholders, which will be
89used when you call run().
90
91=head2 essential
92
93When retrieving rows from the database that match the WHERE clause of
94the query, these are the columns that we fetch back and pre-load the
95resulting objects with. By default this is the Essential column group
96of the owner class.
97
98=head1 METHODS
99
100=head2 where()
101
102	$query->where($match, @columns);
103
104This will extend your 'WHERE' clause by adding a 'AND $column = ?' (or
105whatever $match is, isntead of "=") for each column passed. If you have
106multiple WHERE clauses this will extend the last one.
107
108=cut
109
110sub new {
111	my ($class, $self) = @_;
112	require Carp;
113	Carp::carp "Class::DBI::Query deprecated";
114	$self->{owner}     ||= caller;
115	$self->{kings}     ||= $self->{owner};
116	$self->{essential} ||= [ $self->{owner}->_essential ];
117	$self->{sqlname}   ||= 'SearchSQL';
118	return $class->SUPER::new($self);
119}
120
121sub _essential_string {
122	my $self  = shift;
123	my $table = $self->owner->table_alias;
124	join ", ", map "$table.$_", $self->essential;
125}
126
127sub where {
128	my ($self, $type, @cols) = @_;
129	my @where = $self->where_clause;
130	my $last = pop @where || "";
131	$last .= join " AND ", $self->restrictions;
132	$last .= " ORDER BY " . $self->order_by if $self->order_by;
133	push @where, $last;
134	return @where;
135}
136
137sub add_restriction {
138	my ($self, $sql) = @_;
139	$self->restrictions($self->restrictions, $sql);
140}
141
142sub tables {
143	my $self = shift;
144	join ", ", map { join " ", $_->table, $_->table_alias } $self->kings;
145}
146
147# my $sth = $query->run(@vals);
148# Runs the SQL set up in $sqlname, e.g.
149#
150# SELECT %s (Essential)
151# FROM   %s (Table)
152# WHERE  %s = ? (SelectCol = @vals)
153#
154# substituting the relevant values via sprintf, and then executing with $select_val.
155
156sub run {
157	my $self = shift;
158	my $owner = $self->owner or Class::DBI->_croak("Query has no owner");
159	$owner = ref $owner || $owner;
160	$owner->can('db_Main') or $owner->_croak("No database connection defined");
161	my $sql_name = $self->sqlname or $owner->_croak("Query has no SQL");
162
163	my @sel_vals = @_
164		? ref $_[0] eq "ARRAY" ? @{ $_[0] } : (@_)
165		: ();
166	my $sql_method = "sql_$sql_name";
167
168	my $sth;
169	eval {
170		$sth =
171			$owner->$sql_method($self->_essential_string, $self->tables,
172			$self->where);
173		$sth->execute(@sel_vals);
174	};
175	if ($@) {
176		$owner->_croak(
177			"Can't select for $owner using '$sth->{Statement}' ($sql_name): $@",
178			err => $@);
179		return;
180	}
181	return $sth;
182}
183
1841;
185