X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSourceProxy%2FTable.pm;h=d6bac68f45ddd20415322b584f51dbb329d5ff67;hb=591df363660658ed30e60438c5251ca480925a6f;hp=5cfe4f335a37c7a37eb54de8559f126eeda366c6;hpb=204e81916f5a9b55998c857c86b860414f99a9f6;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/ResultSourceProxy/Table.pm b/lib/DBIx/Class/ResultSourceProxy/Table.pm index 5cfe4f3..d6bac68 100644 --- a/lib/DBIx/Class/ResultSourceProxy/Table.pm +++ b/lib/DBIx/Class/ResultSourceProxy/Table.pm @@ -6,24 +6,29 @@ use warnings; use base qw/DBIx::Class::ResultSourceProxy/; use DBIx::Class::ResultSource::Table; +use Scalar::Util 'blessed'; +use namespace::clean; -__PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table'); +__PACKAGE__->mk_classaccessor(table_class => 'DBIx::Class::ResultSource::Table'); -__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do - # anything yet! +# 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' ) + unless $class->can('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 $table + if $table and $table->result_class eq $class; + + my $table_class = $class->table_class; + $class->ensure_class_loaded($table_class); if( $table ) { - $table = $class->table_class->new({ + $table = $table_class->new({ %$table, result_class => $class, source_name => undef, @@ -31,7 +36,7 @@ sub _init_result_source_instance { }); } else { - $table = $class->table_class->new({ + $table = $table_class->new({ name => undef, result_class => $class, source_name => undef, @@ -67,7 +72,7 @@ Adds columns to the current class and creates accessors for them. =head2 table __PACKAGE__->table('tbl_name'); - + Gets or sets the table name. =cut @@ -75,17 +80,23 @@ Gets or sets the table name. sub table { my ($class, $table) = @_; return $class->result_source_instance->name unless $table; - unless (ref $table) { - $table = $class->table_class->new({ - $class->can('result_source_instance') ? - %{$class->result_source_instance||{}} : (), + + unless (blessed $table && $table->isa($class->table_class)) { + + my $table_class = $class->table_class; + $class->ensure_class_loaded($table_class); + + $table = $table_class->new({ + $class->can('result_source_instance') + ? %{$class->result_source_instance||{}} + : () + , name => $table, result_class => $class, - source_name => undef, }); } - $class->mk_classdata('result_source_instance') + $class->mk_group_accessors(inherited => 'result_source_instance') unless $class->can('result_source_instance'); $class->result_source_instance($table); @@ -93,14 +104,18 @@ sub table { return $class->result_source_instance->name; } +=head2 table_class + + __PACKAGE__->table_class('DBIx::Class::ResultSource::Table'); + +Gets or sets the table class used for construction and validation. + =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); @@ -109,23 +124,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 AUTHORS +=head1 COPYRIGHT AND LICENSE -Matt S. Trout +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