From: Matt S Trout Date: Wed, 14 Dec 2005 19:38:02 +0000 (+0000) Subject: Start of TableInstance code. CDBICompat currently b0rken X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cda04c3afd46989e1964a6c8a277fd7faa11b291;p=dbsrgits%2FDBIx-Class-Historic.git Start of TableInstance code. CDBICompat currently b0rken --- diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm index 99c4b2a..5db8b01 100644 --- a/lib/DBIx/Class/Core.pm +++ b/lib/DBIx/Class/Core.pm @@ -11,7 +11,7 @@ __PACKAGE__->load_components(qw/ Relationship PK Row - Table + TableInstance ResultSetInstance Exception AccessorGroup/); diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index eb2540d..4d46421 100644 --- a/lib/DBIx/Class/PK.pm +++ b/lib/DBIx/Class/PK.pm @@ -79,10 +79,10 @@ sub find { $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 diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 8b8da5f..ce038db 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -33,13 +33,13 @@ any queries -- these are executed as needed by the other methods. =cut sub new { - my ($class, $db_class, $attrs) = @_; + my ($class, $source, $attrs) = @_; #use Data::Dumper; warn Dumper(@_); $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})) { @@ -49,17 +49,18 @@ sub new { $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 = { - source => $db_class, + source => $source, + result_class => $source->result_class, cols => $attrs->{cols}, cond => $attrs->{where}, from => $attrs->{from}, @@ -166,7 +167,7 @@ Returns a subset of elements from the resultset. sub slice { my ($self, $min, $max) = @_; my $attrs = { %{ $self->{attrs} || {} } }; - $self->{source}->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->{source}, $attrs); @@ -193,17 +194,17 @@ sub _construct_object { @cols = grep { /\(/ or ! /\./ } @cols; my $new; unless ($self->{attrs}{prefetch}) { - $new = $self->{source}->_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->{source}->_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->{source}->_relationships->{$pre}; - my $pre_class = $self->{source}->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->{source}->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) { @@ -216,7 +217,7 @@ sub _construct_object { } elsif ($rel_obj->{attrs}{accessor} eq 'filter') { $new->{_inflated_column}{$pre} = $fetched; } else { - $self->{source}->throw("Don't know how to store prefetched $pre"); + $self->{source}->result_class->throw("Don't know how to store prefetched $pre"); } } } diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 4c4942b..fa8e850 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -167,7 +167,9 @@ sub compose_connection { 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); } { diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm index cce20ef..d370ce2 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -6,20 +6,14 @@ use warnings; use DBIx::Class::ResultSet; 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 @@ -32,83 +26,51 @@ L classes. =cut -sub _register_columns { - my ($class, @cols) = @_; - my $names = { %{$class->_columns} }; - while (my $col = shift @cols) { - $names->{$col} = (ref $cols[0] ? shift : {}); - } - $class->_columns($names); -} - -sub _mk_column_accessors { - my ($class, @cols) = @_; - $class->mk_group_accessors('column' => @cols); +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; } -=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); -} - -sub resultset_instance { - my $class = shift; - $class->next::method($class->construct_resultset); -} - -sub construct_resultset { - my $class = shift; - my $rs_class = $class->_resultset_class; - eval "use $rs_class;"; - return $rs_class->new($class); + my ($self, @cols) = @_; + while (my $col = shift @cols) { + $self->add_column($col => (ref $cols[0] ? shift : {})); + } } -sub _select_columns { - return keys %{$_[0]->_columns}; +sub add_column { + my ($self, $col, $info) = @_; + $self->_columns->{$col} = $info || {}; } -=head2 table - - __PACKAGE__->table('tbl_name'); - -Gets or sets the table name. - -=cut - -sub table { - shift->_table_name(@_); -} +=head2 add_columns -=head2 find_or_create + $table->add_columns(qw/col1 col2 col3/); - $class->find_or_create({ key => $val, ... }); + $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...); -Searches for a record matching the search condition; if it doesn't find one, -creates one and returns that instead. +Adds columns to the table object. If supplied key => hashref pairs uses +the hashref as the column_info for that column. =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); +sub resultset { + my $self = shift; + my $rs_class = $self->resultset_class; + eval "use $rs_class;"; + 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 diff --git a/lib/DBIx/Class/TableInstance.pm b/lib/DBIx/Class/TableInstance.pm new file mode 100644 index 0000000..81c3c39 --- /dev/null +++ b/lib/DBIx/Class/TableInstance.pm @@ -0,0 +1,145 @@ +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 + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + diff --git a/t/20setuperrors.t b/t/20setuperrors.t index f082e93..3d36bd4 100644 --- a/t/20setuperrors.t +++ b/t/20setuperrors.t @@ -7,6 +7,7 @@ eval { use base 'DBIx::Class'; __PACKAGE__->load_components qw/Core/; + __PACKAGE__->table('buggy_table'); __PACKAGE__->columns qw/this doesnt work as expected/; };