X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=0ae4b5bde7323a8dfcb212fc4a91025f3abf010d;hb=9642350a5e5cf25c6b185ad6782e6a2341bb1968;hp=ea25e4f793fb0d10c4bfe52fd8cbf721c5fba7ef;hpb=a2bd379666d729133d65c85dc775627937084b18;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index ea25e4f..0ae4b5b 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -3,10 +3,27 @@ package DBIx::Class::AccessorGroup; use strict; use warnings; -use base qw/Class::Accessor::Grouped/; +use base qw( DBIx::Class::MethodAttributes Class::Accessor::Grouped ); +use mro 'c3'; + use Scalar::Util qw/weaken blessed/; +use DBIx::Class::_Util 'fail_on_internal_call'; use namespace::clean; +sub mk_classdata { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->mk_classaccessor(@_); +} + +sub mk_classaccessor { + my $self = shift; + $self->mk_group_accessors('inherited', $_[0]); + (@_ > 1) + ? $self->set_inherited(@_) + : ( DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call ) + ; +} + my $successfully_loaded_components; sub get_component_class { @@ -18,6 +35,8 @@ sub get_component_class { if (defined $class and ! $successfully_loaded_components->{$class} ) { $_[0]->ensure_class_loaded($class); + mro::set_mro( $class, 'c3' ); + no strict 'refs'; $successfully_loaded_components->{$class} = ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} @@ -29,7 +48,11 @@ sub get_component_class { }; sub set_component_class { - shift->set_inherited(@_); + $_[0]->set_inherited($_[1], $_[2]); + + # trigger a load for the case of $foo->component_accessor("bar")->new + $_[0]->get_component_class($_[1]) + if defined wantarray; } 1;