X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSourceProxy%2FTable.pm;h=53dd26f031717f40babb23969febbc5d56c4385c;hb=e570488ade8f327f47dd3318db3443a348d561d6;hp=fe72d4d9b3014d0cc348a9a7962dec34abda68b2;hpb=8893ffd05dee05ba32bb64b4ce16ca805145aeb3;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSourceProxy/Table.pm b/lib/DBIx/Class/ResultSourceProxy/Table.pm index fe72d4d..53dd26f 100644 --- a/lib/DBIx/Class/ResultSourceProxy/Table.pm +++ b/lib/DBIx/Class/ResultSourceProxy/Table.pm @@ -9,43 +9,47 @@ use DBIx::Class::ResultSource::Table; use Scalar::Util 'blessed'; use namespace::clean; -__PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table'); - -__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do - # anything yet! +# FIXME - both of these *PROBABLY* need to be 'inherited_ro_instance' type +__PACKAGE__->mk_classaccessor(table_class => 'DBIx::Class::ResultSource::Table'); +# FIXME: Doesn't actually do anything yet! +__PACKAGE__->mk_group_accessors( inherited => 'table_alias' ); sub _init_result_source_instance { my $class = shift; - $class->mk_classdata('result_source_instance') - unless $class->can('result_source_instance'); + $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] ) + unless $class->can('result_source_instance'); + + # might be pre-made for us courtesy of DBIC::DB::result_source_instance() + my $rsrc = $class->result_source_instance; - my $table = $class->result_source_instance; - my $class_has_table_instance = ($table and $table->result_class eq $class); - return $table if $class_has_table_instance; + return $rsrc + if $rsrc and $rsrc->result_class eq $class; my $table_class = $class->table_class; $class->ensure_class_loaded($table_class); - if( $table ) { - $table = $table_class->new({ - %$table, + if( $rsrc ) { + # + # NOTE! - not using clone() here and *NOT* marking source as derived + # from the one already existing on the class (if any) + # + $rsrc = $table_class->new({ + %$rsrc, result_class => $class, source_name => undef, schema => undef }); } else { - $table = $table_class->new({ + $rsrc = $table_class->new({ name => undef, result_class => $class, source_name => undef, }); } - $class->result_source_instance($table); - - return $table; + $class->result_source_instance($rsrc); } =head1 NAME @@ -78,30 +82,37 @@ Gets or sets the table name. =cut sub table { + return $_[0]->result_source->name unless @_ > 1; + my ($class, $table) = @_; - return $class->result_source_instance->name unless $table; unless (blessed $table && $table->isa($class->table_class)) { + my $ancestor = $class->can('result_source_instance') + ? $class->result_source_instance + : undef + ; + my $table_class = $class->table_class; $class->ensure_class_loaded($table_class); + + # NOTE! - not using clone() here and *NOT* marking source as derived + # from the one already existing on the class (if any) + # This is logically sound as we are operating at class-level, and is + # in fact necessary, as otherwise any base-class with a "dummy" table + # will be marked as an ancestor of everything $table = $table_class->new({ - $class->can('result_source_instance') - ? %{$class->result_source_instance||{}} - : () - , + %{ $ancestor || {} }, name => $table, result_class => $class, }); } - $class->mk_classdata('result_source_instance') + $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] ) unless $class->can('result_source_instance'); - $class->result_source_instance($table); - - return $class->result_source_instance->name; + $class->result_source_instance($table)->name; } =head2 table_class @@ -110,16 +121,12 @@ sub table { Gets or sets the table class used for construction and validation. -=cut - =head2 has_column if ($obj->has_column($col)) { ... } Returns 1 if the class has a column of this name, 0 otherwise. -=cut - =head2 column_info my $info = $obj->column_info($col); @@ -128,23 +135,23 @@ Returns the column metadata hashref for a column. For a description of the various types of column data in this hashref, see L -=cut - =head2 columns my @column_names = $obj->columns; -=cut +=head1 FURTHER QUESTIONS? -1; +Check the list of L. -=head1 AUTHOR AND CONTRIBUTORS +=head1 COPYRIGHT AND LICENSE -See L and L in DBIx::Class +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. -=head1 LICENSE +=cut -You may distribute this code under the same terms as Perl itself. +1; -=cut