Class-DBI
view release on metacpan or search on metacpan
lib/Class/DBI.pm view on Meta::CPAN
sub _deflated_column {
my ($self, $col, $val) = @_;
$val ||= $self->_attrs($col) if ref $self;
return $val unless ref $val;
my $meta = $self->meta_info(has_a => $col) or return $val;
my ($a_class, %meths) = ($meta->foreign_class, %{ $meta->args });
if (my $deflate = $meths{'deflate'}) {
$val = $val->$deflate(ref $deflate eq 'CODE' ? $self : ());
return $val unless ref $val;
}
return $self->_croak("Can't deflate $col: $val is not a $a_class")
unless UNIVERSAL::isa($val, $a_class);
return $val->id if UNIVERSAL::isa($val => 'Class::DBI');
return "$val";
}
#----------------------------------------------------------------------
# SEARCH
#----------------------------------------------------------------------
sub retrieve_all { shift->sth_to_objects('RetrieveAll') }
sub retrieve_from_sql {
my ($class, $sql, @vals) = @_;
$sql =~ s/^\s*(WHERE)\s*//i;
return $class->sth_to_objects($class->sql_Retrieve($sql), \@vals);
}
sub add_searcher {
my ($self, %rels) = @_;
while (my ($name, $class) = each %rels) {
$self->_require_class($class);
$self->_croak("$class is not a valid Searcher")
unless $class->can('run_search');
no strict 'refs';
*{"$self\::$name"} = sub {
$class->new(@_)->run_search;
};
}
}
# This should really be its own Search subclass. But the _do_search
# version has been publicised as the way to do this. We need to
# deprecate this eventually.
sub search_like { shift->_do_search(LIKE => @_) }
sub _do_search {
my ($class, $type, @args) = @_;
$class->_require_class('Class::DBI::Search::Basic');
my $search = Class::DBI::Search::Basic->new($class, @args);
$search->type($type);
$search->run_search;
}
#----------------------------------------------------------------------
# CONSTRUCTORS
#----------------------------------------------------------------------
sub add_constructor {
my ($class, $method, $fragment) = @_;
return $class->_croak("constructors needs a name") unless $method;
no strict 'refs';
my $meth = "$class\::$method";
return $class->_carp("$method already exists in $class")
if *$meth{CODE};
*$meth = sub {
my $self = shift;
$self->sth_to_objects($self->sql_Retrieve($fragment), \@_);
};
}
sub sth_to_objects {
my ($class, $sth, $args) = @_;
$class->_croak("sth_to_objects needs a statement handle") unless $sth;
unless (UNIVERSAL::isa($sth => "DBI::st")) {
my $meth = "sql_$sth";
$sth = $class->$meth();
}
my (%data, @rows);
eval {
$sth->execute(@$args) unless $sth->{Active};
$sth->bind_columns(\(@data{ @{ $sth->{NAME_lc} } }));
push @rows, {%data} while $sth->fetch;
};
return $class->_croak("$class can't $sth->{Statement}: $@", err => $@)
if $@;
return $class->_ids_to_objects(\@rows);
}
*_sth_to_objects = \&sth_to_objects;
sub _my_iterator {
my $self = shift;
my $class = $self->iterator_class;
$self->_require_class($class);
return $class;
}
sub _ids_to_objects {
my ($class, $data) = @_;
return $#$data + 1 unless defined wantarray;
return map $class->construct($_), @$data if wantarray;
return $class->_my_iterator->new($class => $data);
}
#----------------------------------------------------------------------
# SINGLE VALUE SELECTS
#----------------------------------------------------------------------
sub _single_row_select {
my ($self, $sth, @args) = @_;
Carp::confess("_single_row_select is deprecated in favour of select_row");
return $sth->select_row(@args);
}
sub _single_value_select {
my ($self, $sth, @args) = @_;
$self->_carp("_single_value_select is deprecated in favour of select_val");
return $sth->select_val(@args);
}
sub count_all { shift->sql_single("COUNT(*)")->select_val }
sub maximum_value_of {
my ($class, $col) = @_;
$class->sql_single("MAX($col)")->select_val;
}
sub minimum_value_of {
lib/Class/DBI.pm view on Meta::CPAN
For example:
Music::CD->add_constructor(new_music => 'year > 2000');
my @recent = Music::CD->new_music;
You can also supply placeholders in your SQL, which must then be
specified at query time:
Music::CD->add_constructor(new_music => 'year > ?');
my @recent = Music::CD->new_music(2000);
=head2 retrieve_from_sql
On occasions where you want to execute arbitrary SQL, but don't want
to go to the trouble of setting up a constructor method, you can inline
the entire WHERE clause, and just get the objects back directly:
my @cds = Music::CD->retrieve_from_sql(qq{
artist = 'Ozzy Osbourne' AND
title like "%Crazy" AND
year <= 1986
ORDER BY year
LIMIT 2,3
});
=head2 Ima::DBI queries
When you can't use 'add_constructor', e.g. when using aggregate functions,
you can fall back on the fact that Class::DBI inherits from Ima::DBI
and prefers to use its style of dealing with statements, via set_sql().
The Class::DBI set_sql() method defaults to using prepare_cached()
unless the $cache parameter is defined and false (see L<Ima::DBI> docs for
more information).
To assist with writing SQL that is inheritable into subclasses, several
additional substitutions are available here: __TABLE__, __ESSENTIAL__
and __IDENTIFIER__. These represent the table name associated with the
class, its essential columns, and the primary key of the current object,
in the case of an instance method on it.
For example, the SQL for the internal 'update' method is implemented as:
__PACKAGE__->set_sql('update', <<"");
UPDATE __TABLE__
SET %s
WHERE __IDENTIFIER__
The 'longhand' version of the new_music constructor shown above would
similarly be:
Music::CD->set_sql(new_music => qq{
SELECT __ESSENTIAL__
FROM __TABLE__
WHERE year > ?
});
For such 'SELECT' queries L<Ima::DBI>'s set_sql() method is extended to
create a helper shortcut method, named by prefixing the name of the
SQL fragment with 'search_'. Thus, the above call to set_sql() will
automatically set up the method Music::CD->search_new_music(), which
will execute this search and return the relevant objects or Iterator.
(If there are placeholders in the query, you must pass the relevant
arguments when calling your search method.)
This does the equivalent of:
sub search_new_music {
my ($class, @args) = @_;
my $sth = $class->sql_new_music;
$sth->execute(@args);
return $class->sth_to_objects($sth);
}
The $sth which is used to return the objects here is a normal DBI-style
statement handle, so if the results can't be turned into objects easily,
it is still possible to call $sth->fetchrow_array etc and return whatever
data you choose.
Of course, any query can be added via set_sql, including joins. So,
to add a query that returns the 10 Artists with the most CDs, you could
write (with MySQL):
Music::Artist->set_sql(most_cds => qq{
SELECT artist.id, COUNT(cd.id) AS cds
FROM artist, cd
WHERE artist.id = cd.artist
GROUP BY artist.id
ORDER BY cds DESC
LIMIT 10
});
my @artists = Music::Artist->search_most_cds();
If you also need to access the 'cds' value returned from this query,
the best approach is to declare 'cds' to be a TEMP column. (See
L<"Non-Persistent Fields"> below).
=head2 Class::DBI::AbstractSearch
my @music = Music::CD->search_where(
artist => [ 'Ozzy', 'Kelly' ],
status => { '!=', 'outdated' },
);
The L<Class::DBI::AbstractSearch> module, available from CPAN, is a
plugin for Class::DBI that allows you to write arbitrarily complex
searches using perl data structures, rather than SQL.
=head2 Single Value SELECTs
=head3 select_val
Selects which only return a single value can couple Class::DBI's
sql_single() SQL, with the $sth->select_val() call which we get from
DBIx::ContextualFetch.
__PACKAGE__->set_sql(count_all => "SELECT COUNT(*) FROM __TABLE__");
# .. then ..
my $count = $class->sql_count_all->select_val;
This can also take placeholders and/or do column interpolation if required:
__PACKAGE__->set_sql(count_above => q{
SELECT COUNT(*) FROM __TABLE__ WHERE %s > ?
});
# .. then ..
my $count = $class->sql_count_above('year')->select_val(2001);
=head3 sql_single
Internally Class::DBI defines a very simple SQL fragment called 'single':
"SELECT %s FROM __TABLE__".
This is used to implement the above Class->count_all():
$class->sql_single("COUNT(*)")->select_val;
This interpolates the COUNT(*) into the %s of the SQL, and then executes
the query, returning a single value.
Any SQL set up via set_sql() can of course be supplied here, and
select_val can take arguments for any placeholders there.
Internally several helper methods are defined using this approach:
=over 4
=item - count_all
=item - maximum_value_of($column)
=item - minimum_value_of($column)
=back
=head1 LAZY POPULATION
In the tradition of Perl, Class::DBI is lazy about how it loads your
objects. Often, you find yourself using only a small number of the
available columns and it would be a waste of memory to load all of them
just to get at two, especially if you're dealing with large numbers of
objects simultaneously.
You should therefore group together your columns by typical usage, as
fetching one value from a group can also pre-fetch all the others in
that group for you, for more efficient access.
So for example, if we usually fetch the artist and title, but don't use
the 'year' so much, then we could say the following:
Music::CD->columns(Primary => qw/cdid/);
Music::CD->columns(Essential => qw/artist title/);
Music::CD->columns(Others => qw/year runlength/);
Now when you fetch back a CD it will come pre-loaded with the 'cdid',
'artist' and 'title' fields. Fetching the 'year' will mean another visit
to the database, but will bring back the 'runlength' whilst it's there.
This can potentially increase performance.
If you don't like this behavior, then just add all your columns to the
Essential group, and Class::DBI will load everything at once. If you
have a single column primary key you can do this all in one shot with
one single column declaration:
Music::CD->columns(Essential => qw/cdid artist title year runlength/);
=head2 columns
my @all_columns = $class->columns;
( run in 1.021 second using v1.01-cache-2.11-cpan-364913b4093 )