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