Class::DBI::Query - Deprecated SQL manager for Class::DBI

Class-DBI documentation Contained in the Class-DBI distribution.

Index

Code Index:

NAME

Top

Class::DBI::Query - Deprecated SQL manager for Class::DBI

SYNOPSIS

Top

	my $sth = Class::DBI::Query
		->new({ 
			owner => $class, 
			sqlname => $type, 
			essential => \@columns, 
			where_columns => \@where_cols,
		})
		->run($val);

DESCRIPTION

Top

This abstracts away many of the details of the Class::DBI underlying SQL mechanism. For the most part you probably don't want to be interfacing directly with this.

The underlying mechanisms are not yet stable, and are subject to change at any time.

OPTIONS

Top

A Query can have many options set before executing. Most can either be passed as an option to new(), or set later if you are building the query up dynamically:

owner

The Class::DBI subclass that 'owns' this query. In the vast majority of cases a query will return objects - the owner is the class of which instances will be returned.

sqlname

This should be the name of a query set up using set_sql.

where_clause

This is the raw SQL that will substituted into the 'WHERE %s' in your query. If you have multiple %s's in your query then you should supply a listref of where_clauses. This SQL can include placeholders, which will be used when you call run().

essential

When retrieving rows from the database that match the WHERE clause of the query, these are the columns that we fetch back and pre-load the resulting objects with. By default this is the Essential column group of the owner class.

METHODS

Top

where()

	$query->where($match, @columns);

This will extend your 'WHERE' clause by adding a 'AND $column = ?' (or whatever $match is, isntead of "=") for each column passed. If you have multiple WHERE clauses this will extend the last one.

Class-DBI documentation Contained in the Class-DBI distribution. 
package Class::DBI::Query::Base;

use strict;

use base 'Class::Accessor';
use Storable 'dclone';

sub new {
	my ($class, $fields) = @_;
	my $self = $class->SUPER::new();
	foreach my $key (keys %{ $fields || {} }) {
		$self->set($key => $fields->{$key});
	}
	$self;
}

sub get {
	my ($self, $key) = @_;
	my @vals = @{ $self->{$key} || [] };
	return wantarray ? @vals : $vals[0];
}

sub set {
	my ($self, $key, @args) = @_;
	@args = map { ref $_ eq "ARRAY" ? @$_ : $_ } @args;
	$self->{$key} = [@args];
}

sub clone { dclone shift }

package Class::DBI::Query;

use base 'Class::DBI::Query::Base';

__PACKAGE__->mk_accessors(
	qw/
		owner essential sqlname where_clause restrictions order_by kings
		/
);


sub new {
	my ($class, $self) = @_;
	require Carp;
	Carp::carp "Class::DBI::Query deprecated";
	$self->{owner}     ||= caller;
	$self->{kings}     ||= $self->{owner};
	$self->{essential} ||= [ $self->{owner}->_essential ];
	$self->{sqlname}   ||= 'SearchSQL';
	return $class->SUPER::new($self);
}

sub _essential_string {
	my $self  = shift;
	my $table = $self->owner->table_alias;
	join ", ", map "$table.$_", $self->essential;
}

sub where {
	my ($self, $type, @cols) = @_;
	my @where = $self->where_clause;
	my $last = pop @where || "";
	$last .= join " AND ", $self->restrictions;
	$last .= " ORDER BY " . $self->order_by if $self->order_by;
	push @where, $last;
	return @where;
}

sub add_restriction {
	my ($self, $sql) = @_;
	$self->restrictions($self->restrictions, $sql);
}

sub tables {
	my $self = shift;
	join ", ", map { join " ", $_->table, $_->table_alias } $self->kings;
}

# my $sth = $query->run(@vals);
# Runs the SQL set up in $sqlname, e.g.
#
# SELECT %s (Essential)
# FROM   %s (Table)
# WHERE  %s = ? (SelectCol = @vals)
#
# substituting the relevant values via sprintf, and then executing with $select_val.

sub run {
	my $self = shift;
	my $owner = $self->owner or Class::DBI->_croak("Query has no owner");
	$owner = ref $owner || $owner;
	$owner->can('db_Main') or $owner->_croak("No database connection defined");
	my $sql_name = $self->sqlname or $owner->_croak("Query has no SQL");

	my @sel_vals = @_
		? ref $_[0] eq "ARRAY" ? @{ $_[0] } : (@_)
		: ();
	my $sql_method = "sql_$sql_name";

	my $sth;
	eval {
		$sth =
			$owner->$sql_method($self->_essential_string, $self->tables,
			$self->where);
		$sth->execute(@sel_vals);
	};
	if ($@) {
		$owner->_croak(
			"Can't select for $owner using '$sth->{Statement}' ($sql_name): $@",
			err => $@);
		return;
	}
	return $sth;
}

1;