X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSourceProxy.pm;h=859b39729d5a18a8a6c53d8c9b09803a529d3dcb;hb=a93c65f29d8a3fc58e0d19fec4195a371c999fea;hp=c1d61648fb5f71e47688bf9df40974a3fe07bfcf;hpb=a9196897efe0c699d743adcf41ba5ebcdaf30931;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm index c1d6164..859b397 100644 --- a/lib/DBIx/Class/ResultSourceProxy.pm +++ b/lib/DBIx/Class/ResultSourceProxy.pm @@ -5,86 +5,84 @@ use strict; use warnings; use base qw/DBIx::Class/; +use Scalar::Util qw/blessed/; +use Sub::Name qw/subname/; +use namespace::clean; -sub iterator_class { shift->result_source_instance->resultset_class(@_) } -sub resultset_class { shift->result_source_instance->resultset_class(@_) } -sub result_class { shift->result_source_instance->result_class(@_) } -sub source_name { shift->result_source_instance->source_name(@_) } +__PACKAGE__->mk_group_accessors('inherited_ro_instance' => 'source_name'); -sub resultset_attributes { - shift->result_source_instance->resultset_attributes(@_); +sub get_inherited_ro_instance { shift->get_inherited(@_) } + +sub set_inherited_ro_instance { + my $self = shift; + + $self->throw_exception ("Cannot set @{[shift]} on an instance") + if blessed $self; + + $self->set_inherited(@_); } + sub add_columns { my ($class, @cols) = @_; my $source = $class->result_source_instance; $source->add_columns(@cols); foreach my $c (grep { !ref } @cols) { + # If this is an augment definition get the real colname. + $c =~ s/^\+//; + $class->register_column($c => $source->column_info($c)); } } -*add_column = \&add_columns; - -sub has_column { - shift->result_source_instance->has_column(@_); -} +sub add_column { shift->add_columns(@_) } -sub column_info { - shift->result_source_instance->column_info(@_); -} -sub load_column_info_from_storage { - shift->result_source_instance->load_column_info_from_storage; -} - -sub columns { - shift->result_source_instance->columns(@_); -} - -sub remove_columns { - shift->result_source_instance->remove_columns(@_); +sub add_relationship { + my ($class, $rel, @rest) = @_; + my $source = $class->result_source_instance; + $source->add_relationship($rel => @rest); + $class->register_relationship($rel => $source->relationship_info($rel)); } -*remove_column = \&remove_columns; -sub set_primary_key { - shift->result_source_instance->set_primary_key(@_); -} +# legacy resultset_class accessor, seems to be used by cdbi only +sub iterator_class { shift->result_source_instance->resultset_class(@_) } -sub primary_columns { - shift->result_source_instance->primary_columns(@_); -} +for my $method_to_proxy (qw/ + source_info + result_class + resultset_class + resultset_attributes -sub add_unique_constraint { - shift->result_source_instance->add_unique_constraint(@_); -} + columns + has_column -sub unique_constraints { - shift->result_source_instance->unique_constraints(@_); -} + remove_column + remove_columns -sub unique_constraint_names { - shift->result_source_instance->unique_constraint_names(@_); -} + column_info + column_info_from_storage -sub unique_constraint_columns { - shift->result_source_instance->unique_constraint_columns(@_); -} + set_primary_key + primary_columns + _pri_cols -sub add_relationship { - my ($class, $rel, @rest) = @_; - my $source = $class->result_source_instance; - $source->add_relationship($rel => @rest); - $class->register_relationship($rel => $source->relationship_info($rel)); -} + add_unique_constraint + add_unique_constraints -sub relationships { - shift->result_source_instance->relationships(@_); -} + unique_constraints + unique_constraint_names + unique_constraint_columns -sub relationship_info { - shift->result_source_instance->relationship_info(@_); + relationships + relationship_info + has_relationship +/) { + no strict qw/refs/; + *{__PACKAGE__."::$method_to_proxy"} = subname $method_to_proxy => sub { + shift->result_source_instance->$method_to_proxy (@_); + }; } 1;