'Tie::IxHash' => 0,
'Module::Find' => 0,
'Storable' => 0,
+ 'Class::Data::Accessor' => 0.01,
# Following for CDBICompat only
'Class::Trigger' => 0,
'DBIx::ContextualFetch' => 0,
use warnings;
use vars qw($VERSION);
-use base qw/DBIx::Class::Componentised Class::Data::Inheritable/;
+use base qw/DBIx::Class::Componentised Class::Data::Accessor/;
-$VERSION = '0.04001';
+sub mk_classdata { shift->mk_classaccessor(@_); }
+
+$VERSION = '0.04999_01';
1;
sub retrieve { shift->find(@_) }
sub retrieve_all { shift->search }
-sub retrieve_from_sql { shift->search_literal(@_) }
+
+sub retrieve_from_sql {
+ my ($class, $cond, @rest) = @_;
+ $cond =~ s/^\s*WHERE//i;
+ $class->search_literal($cond, @rest);
+}
sub count_all { shift->count }
# Contributed by Numa. No test for this though.
Relationship
PK
Row
- Table
+ TableInstance
+ ResultSetInstance
Exception
AccessorGroup
Validation/);
$class->throw( "Can't find unless all primary keys are specified" )
unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
# column names etc. Not sure what to do yet
- #return $class->search($query)->next;
- my @cols = $class->_select_columns;
- my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
- return (@row ? $class->_row_to_object(\@cols, \@row) : ());
+ return $class->search($query)->next;
+ #my @cols = $class->_select_columns;
+ #my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
+ #return (@row ? $class->_row_to_object(\@cols, \@row) : ());
}
=head2 discard_changes
=cut
sub new {
- my ($it_class, $db_class, $attrs) = @_;
+ my ($class, $source, $attrs) = @_;
#use Data::Dumper; warn Dumper(@_);
- $it_class = ref $it_class if ref $it_class;
+ $class = ref $class if ref $class;
$attrs = { %{ $attrs || {} } };
my %seen;
- $attrs->{cols} ||= [ map { "me.$_" } $db_class->_select_columns ];
- $attrs->{from} ||= [ { 'me' => $db_class->_table_name } ];
+ $attrs->{cols} ||= [ map { "me.$_" } $source->columns ];
+ $attrs->{from} ||= [ { 'me' => $source->name } ];
if ($attrs->{join}) {
foreach my $j (ref $attrs->{join} eq 'ARRAY'
? (@{$attrs->{join}}) : ($attrs->{join})) {
$seen{$j} = 1;
}
}
- push(@{$attrs->{from}}, $db_class->_resolve_join($attrs->{join}, 'me'));
+ push(@{$attrs->{from}}, $source->result_class->_resolve_join($attrs->{join}, 'me'));
}
foreach my $pre (@{$attrs->{prefetch} || []}) {
- push(@{$attrs->{from}}, $db_class->_resolve_join($pre, 'me'))
+ push(@{$attrs->{from}}, $source->result_class->_resolve_join($pre, 'me'))
unless $seen{$pre};
push(@{$attrs->{cols}},
map { "$pre.$_" }
- $db_class->_relationships->{$pre}->{class}->_select_columns);
+ $source->result_class->_relationships->{$pre}->{class}->table->columns);
}
my $new = {
- class => $db_class,
- cols => $attrs->{cols} || [ $db_class->_select_columns ],
+ source => $source,
+ result_class => $source->result_class,
+ cols => $attrs->{cols},
cond => $attrs->{where},
- from => $attrs->{from} || $db_class->_table_name,
+ from => $attrs->{from},
count => undef,
pager => undef,
attrs => $attrs };
- bless ($new, $it_class);
+ bless ($new, $class);
$new->pager if ($attrs->{page});
return $new;
}
+=head2 search
+
+ my @obj = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
+ my $new_rs = $rs->search({ foo => 3 });
+
+If you need to pass in additional attributes but no additional condition,
+call it as ->search(undef, \%attrs);
+
+ my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
+
+=cut
+
+sub search {
+ my $self = shift;
+
+ #use Data::Dumper;warn Dumper(@_);
+
+ my $attrs = { %{$self->{attrs}} };
+ if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+ $attrs = { %{ pop(@_) } };
+ }
+
+ my $where = ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_});
+ if (defined $where) {
+ $where = (defined $attrs->{where}
+ ? { '-and' => [ $where, $attrs->{where} ] }
+ : $where);
+ $attrs->{where} = $where;
+ }
+
+ my $rs = $self->new($self->{source}, $attrs);
+
+ return (wantarray ? $rs->all : $rs);
+}
+
+=head2 search_literal
+ my @obj = $rs->search_literal($literal_where_cond, @bind);
+ my $new_rs = $rs->search_literal($literal_where_cond, @bind);
+
+Pass a literal chunk of SQL to be added to the conditional part of the
+resultset
+
+=cut
+
+sub search_literal {
+ my ($self, $cond, @vals) = @_;
+ my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
+ $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
+ return $self->search(\$cond, $attrs);
+}
+
=head2 cursor
-Return a storage-driven cursor to the given resultset.
+Returns a storage-driven cursor to the given resultset.
=cut
sub cursor {
my ($self) = @_;
- my ($db_class, $attrs) = @{$self}{qw/class attrs/};
+ my ($source, $attrs) = @{$self}{qw/source attrs/};
if ($attrs->{page}) {
$attrs->{rows} = $self->pager->entries_per_page;
$attrs->{offset} = $self->pager->skipped;
}
return $self->{cursor}
- ||= $db_class->storage->select($self->{from}, $self->{cols},
+ ||= $source->storage->select($self->{from}, $self->{cols},
$attrs->{where},$attrs);
}
+=head2 search_like
+
+Identical to search except defaults to 'LIKE' instead of '=' in condition
+
+=cut
+
+sub search_like {
+ my $class = shift;
+ my $attrs = { };
+ if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+ $attrs = pop(@_);
+ }
+ my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
+ $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
+ return $class->search($query, { %$attrs });
+}
+
=head2 slice($first, $last)
Returns a subset of elements from the resultset.
sub slice {
my ($self, $min, $max) = @_;
my $attrs = { %{ $self->{attrs} || {} } };
- $self->{class}->throw("Can't slice without where") unless $attrs->{where};
+ $self->{source}->result_class->throw("Can't slice without where") unless $attrs->{where};
$attrs->{offset} = $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = $self->new($self->{class}, $attrs);
+ my $slice = $self->new($self->{source}, $attrs);
return (wantarray ? $slice->all : $slice);
}
@cols = grep { /\(/ or ! /\./ } @cols;
my $new;
unless ($self->{attrs}{prefetch}) {
- $new = $self->{class}->_row_to_object(\@cols, \@row);
+ $new = $self->{source}->result_class->_row_to_object(\@cols, \@row);
} else {
my @main = splice(@row, 0, scalar @cols);
- $new = $self->{class}->_row_to_object(\@cols, \@main);
+ $new = $self->{source}->result_class->_row_to_object(\@cols, \@main);
PRE: foreach my $pre (@{$self->{attrs}{prefetch}}) {
- my $rel_obj = $self->{class}->_relationships->{$pre};
- my $pre_class = $self->{class}->resolve_class($rel_obj->{class});
+ my $rel_obj = $self->{source}->result_class->_relationships->{$pre};
+ my $pre_class = $self->{source}->result_class->resolve_class($rel_obj->{class});
my @pre_cols = $pre_class->_select_columns;
my @vals = splice(@row, 0, scalar @pre_cols);
my $fetched = $pre_class->_row_to_object(\@pre_cols, \@vals);
- $self->{class}->throw("No accessor for prefetched $pre")
+ $self->{source}->result_class->throw("No accessor for prefetched $pre")
unless defined $rel_obj->{attrs}{accessor};
if ($rel_obj->{attrs}{accessor} eq 'single') {
foreach my $pri ($rel_obj->{class}->primary_columns) {
} elsif ($rel_obj->{attrs}{accessor} eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
} else {
- $self->{class}->throw("Don't know how to store prefetched $pre");
+ $self->{source}->result_class->throw("Don't know how to store prefetched $pre");
}
}
}
=head2 count
Performs an SQL C<COUNT> with the same query as the resultset was built
-with to find the number of elements.
+with to find the number of elements. If passed arguments, does a search
+on the resultset and counts the results of that.
=cut
sub count {
- my ($self) = @_;
- my $db_class = $self->{class};
+ my $self = shift;
+ return $self->search(@_)->count if @_ && defined $_[0];
my $attrs = { %{ $self->{attrs} } };
unless ($self->{count}) {
# offset and order by are not needed to count
delete $attrs->{$_} for qw/offset order_by/;
my @cols = 'COUNT(*)';
- $self->{count} = $db_class->storage->select_single($self->{from}, \@cols,
- $self->{cond}, $attrs);
+ $self->{count} = $self->{source}->storage->select_single(
+ $self->{from}, \@cols, $self->{cond}, $attrs);
}
return 0 unless $self->{count};
return $self->{pager}->entries_on_this_page if ($self->{pager});
: $self->{count};
}
+=head2 count_literal
+
+Calls search_literal with the passed arguments, then count.
+
+=cut
+
+sub count_literal { shift->search_literal(@_)->count; }
+
=head2 all
Returns all elements in the resultset. Called implictly if the resultset
my ($self, $page) = @_;
my $attrs = $self->{attrs};
$attrs->{page} = $page;
- return $self->new($self->{class}, $attrs);
+ return $self->new($self->{source}, $attrs);
}
=head1 Attributes
--- /dev/null
+package DBIx::Class::ResultSetInstance;
+
+use base qw/DBIx::Class/;
+
+sub search { shift->resultset_instance->search(@_); }
+sub search_literal { shift->resultset_instance->search_literal(@_); }
+sub search_like { shift->resultset_instance->search_like(@_); }
+sub count { shift->resultset_instance->count(@_); }
+sub count_literal { shift->resultset_instance->count_literal(@_); }
+
+__PACKAGE__->mk_classdata('resultset_instance');
+
+1;
while (my ($comp, $comp_class) = each %reg) {
my $target_class = "${target}::${comp}";
$class->inject_base($target_class, $comp_class, $conn_class);
- $target_class->table($comp_class->table);
+ my $table = $comp_class->table->new({ %{$comp_class->table} });
+ $table->result_class($target_class);
+ $target_class->table($table);
@map{$comp, $comp_class} = ($target_class, $target_class);
}
{
my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
unshift(@bind, @$extra_bind) if $extra_bind;
warn "$sql: @bind" if $self->debug;
- my $sth = $self->sth($sql);
+ my $sth = $self->sth($sql,$op);
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv = $sth->execute(@bind);
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
sub sth {
- shift->dbh->prepare(@_);
+ my ($self, $sql, $op) = @_;
+ my $meth = (defined $op && $op ne 'select' ? 'prepare_cached' : 'prepare');
+ return $self->dbh->$meth($sql);
}
1;
use warnings;
use DBIx::Class::ResultSet;
-use Data::Page;
use Carp qw/croak/;
use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/AccessorGroup/);
-__PACKAGE__->mk_classdata('_columns' => {});
-
-__PACKAGE__->mk_classdata('_table_name');
-
-__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
-
-__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
-
-sub iterator_class { shift->_resultset_class(@_) }
+__PACKAGE__->mk_group_accessors('simple' =>
+ qw/_columns name resultset_class result_class storage/);
=head1 NAME
-DBIx::Class::Table - Basic table methods
+DBIx::Class::Table - Table object
=head1 SYNOPSIS
=cut
-sub _register_columns {
- my ($class, @cols) = @_;
- my $names = { %{$class->_columns} };
- $names->{$_} ||= {} for @cols;
- $class->_columns($names);
+sub new {
+ my ($class, $attrs) = @_;
+ $class = ref $class if ref $class;
+ my $new = bless($attrs || {}, $class);
+ $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
+ $new->{_columns} ||= {};
+ $new->{name} ||= "!!NAME NOT SET!!";
+ return $new;
}
-sub _mk_column_accessors {
- my ($class, @cols) = @_;
- $class->mk_group_accessors('column' => @cols);
-}
-
-=head2 add_columns
-
- __PACKAGE__->add_columns(qw/col1 col2 col3/);
-
-Adds columns to the current class and creates accessors for them.
-
-=cut
-
sub add_columns {
- my ($class, @cols) = @_;
- $class->_register_columns(@cols);
- $class->_mk_column_accessors(@cols);
-}
-
-=head2 search_literal
-
- my @obj = $class->search_literal($literal_where_cond, @bind);
- my $cursor = $class->search_literal($literal_where_cond, @bind);
-
-=cut
-
-sub search_literal {
- my ($class, $cond, @vals) = @_;
- $cond =~ s/^\s*WHERE//i;
- my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
- $attrs->{bind} = \@vals;
- return $class->search(\$cond, $attrs);
-}
-
-=head2 count_literal
-
- my $count = $class->count_literal($literal_where_cond);
-
-=cut
-
-sub count_literal {
- my $class = shift;
- return $class->search_literal(@_)->count;
+ my ($self, @cols) = @_;
+ while (my $col = shift @cols) {
+ $self->add_column($col => (ref $cols[0] ? shift : {}));
+ }
}
-=head2 count
-
- my $count = $class->count({ foo => 3 });
-
-=cut
-
-sub count {
- my $class = shift;
- return $class->search(@_)->count;
+sub add_column {
+ my ($self, $col, $info) = @_;
+ $self->_columns->{$col} = $info || {};
}
-=head2 search
-
- my @obj = $class->search({ foo => 3 }); # "... WHERE foo = 3"
- my $cursor = $class->search({ foo => 3 });
-
-To retrieve all rows, simply call C<search()> with no condition parameter,
+=head2 add_columns
- my @all = $class->search(); # equivalent to search({})
+ $table->add_columns(qw/col1 col2 col3/);
-If you need to pass in additional attributes (see
-L<DBIx::Class::ResultSet/Attributes> for details) an empty hash indicates
-no condition,
+ $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
- my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
+Adds columns to the table object. If supplied key => hashref pairs uses
+the hashref as the column_info for that column.
=cut
-sub search {
- my $class = shift;
- my $attrs = { };
- croak "Table not defined for ". ( ref $class || $class ) unless $class->table();
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = { %{ pop(@_) } };
- }
- $attrs->{where} = (@_ == 1 || ref $_[0] eq "HASH" ? shift: {@_});
-
- my $rs = $class->resultset($attrs);
-
- return (wantarray ? $rs->all : $rs);
-}
-
sub resultset {
- my $class = shift;
-
- my $rs_class = $class->_resultset_class;
+ my $self = shift;
+ my $rs_class = $self->resultset_class;
eval "use $rs_class;";
- my $rs = $rs_class->new($class, @_);
-}
-
-=head2 search_like
-
-Identical to search except defaults to 'LIKE' instead of '=' in condition
-
-=cut
-
-sub search_like {
- my $class = shift;
- my $attrs = { };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = pop(@_);
- }
- my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
- $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
- return $class->search($query, { %$attrs });
-}
-
-sub _select_columns {
- return keys %{$_[0]->_columns};
-}
-
-=head2 table
-
- __PACKAGE__->table('tbl_name');
-
-Gets or sets the table name.
-
-=cut
-
-sub table {
- shift->_table_name(@_);
-}
-
-=head2 find_or_create
-
- $class->find_or_create({ key => $val, ... });
-
-Searches for a record matching the search condition; if it doesn't find one,
-creates one and returns that instead.
-
-=cut
-
-sub find_or_create {
- my $class = shift;
- my $hash = ref $_[0] eq "HASH" ? shift: {@_};
- my $exists = $class->find($hash);
- return defined($exists) ? $exists : $class->create($hash);
+ return $rs_class->new($self);
}
=head2 has_column
if ($obj->has_column($col)) { ... }
-Returns 1 if the class has a column of this name, 0 otherwise.
+Returns 1 if the table has a column of this name, 0 otherwise.
=cut
--- /dev/null
+package DBIx::Class::TableInstance;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+use DBIx::Class::Table;
+
+__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
+
+__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
+
+sub iterator_class { shift->table->resultset_class(@_) }
+sub resultset_class { shift->table->resultset_class(@_) }
+sub _table_name { shift->table->name }
+
+=head1 NAME
+
+DBIx::Class::TableInstance - provides a classdata table object and method proxies
+
+=head1 SYNOPSIS
+
+ __PACKAGE__->table('foo');
+ __PACKAGE__->add_columns(qw/id bar baz/);
+ __PACKAGE__->set_primary_key('id');
+
+=head1 METHODS
+
+=cut
+
+sub _mk_column_accessors {
+ my ($class, @cols) = @_;
+ $class->mk_group_accessors('column' => @cols);
+}
+
+=head2 add_columns
+
+ __PACKAGE__->add_columns(qw/col1 col2 col3/);
+
+Adds columns to the current class and creates accessors for them.
+
+=cut
+
+sub add_columns {
+ my ($class, @cols) = @_;
+ $class->table->add_columns(@cols);
+ $class->_mk_column_accessors(@cols);
+}
+
+sub resultset_instance {
+ my $class = shift;
+ $class->table->storage($class->storage);
+ $class->next::method($class->table->resultset);
+}
+
+sub _select_columns {
+ return shift->table->columns;
+}
+
+=head2 table
+
+ __PACKAGE__->table('tbl_name');
+
+Gets or sets the table name.
+
+=cut
+
+sub table {
+ my ($class, $table) = @_;
+ die "$class->table called and no table instance set yet" unless $table;
+ unless (ref $table) {
+ $table = DBIx::Class::Table->new(
+ {
+ name => $table,
+ result_class => $class,
+ #storage => $class->storage,
+ });
+ }
+ $class->mk_classdata('table' => $table);
+}
+
+=head2 find_or_create
+
+ $class->find_or_create({ key => $val, ... });
+
+Searches for a record matching the search condition; if it doesn't find one,
+creates one and returns that instead.
+
+=cut
+
+sub find_or_create {
+ my $class = shift;
+ my $hash = ref $_[0] eq "HASH" ? shift: {@_};
+ my $exists = $class->find($hash);
+ return defined($exists) ? $exists : $class->create($hash);
+}
+
+=head2 has_column
+
+ if ($obj->has_column($col)) { ... }
+
+Returns 1 if the class has a column of this name, 0 otherwise.
+
+=cut
+
+sub has_column {
+ my ($self, $column) = @_;
+ return $self->table->has_column($column);
+}
+
+=head2 column_info
+
+ my $info = $obj->column_info($col);
+
+Returns the column metadata hashref for a column.
+
+=cut
+
+sub column_info {
+ my ($self, $column) = @_;
+ return $self->table->column_info($column);
+}
+
+=head2 columns
+
+ my @column_names = $obj->columns;
+
+=cut
+
+sub columns {
+ return shift->table->columns(@_);
+}
+
+1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
use base 'DBIx::Class';
__PACKAGE__->load_components qw/Core/;
+ __PACKAGE__->table('buggy_table');
__PACKAGE__->columns qw/this doesnt work as expected/;
};
package main;
Actor->iterator_class('Class::DBI::My::Iterator');
+Actor->resultset_instance(Actor->construct_resultset);
{
my @acts = $film->actors->slice(1, 2);
projects / dbsrgits/DBIx-Class.git / commitdiff