X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAccessorGroup.pm;h=d4493e21843946da2255e2f542382091f1fea362;hb=84bf5d8caa798edfa99e79d36d34c27604b28f18;hp=c76a4564d298884846e14e3de99b8377e1a13ea7;hpb=d46eac43287ebe244e4f622fb77fa2efa16402a9;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm index c76a456..d4493e2 100644 --- a/lib/DBIx/Class/AccessorGroup.pm +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -4,18 +4,17 @@ use strict; use warnings; use base qw( DBIx::Class::MethodAttributes Class::Accessor::Grouped ); -use mro 'c3'; use Scalar::Util 'blessed'; use DBIx::Class::_Util 'fail_on_internal_call'; use namespace::clean; -sub mk_classdata { +sub mk_classdata :DBIC_method_is_indirect_sugar { DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; shift->mk_classaccessor(@_); } -sub mk_classaccessor { +sub mk_classaccessor :DBIC_method_is_indirect_sugar { my $self = shift; $self->mk_group_accessors('inherited', $_[0]); (@_ > 1) @@ -24,6 +23,48 @@ sub mk_classaccessor { ; } +sub mk_group_accessors { + my $class = shift; + my $type = shift; + + $class->next::method($type, @_); + + # label things + if( $type =~ /^ ( inflated_ | filtered_ )? column $/x ) { + + $class = ref $class + if length ref $class; + + for my $acc_pair ( + map + { [ $_, "_${_}_accessor" ] } + map + { ref $_ ? $_->[0] : $_ } + @_ + ) { + + for my $i (0, 1) { + + my $acc_name = $acc_pair->[$i]; + + attributes->import( + $class, + ( + $class->can($acc_name) + || + Carp::confess("Accessor '$acc_name' we just created on $class can't be found...?") + ), + 'DBIC_method_is_generated_from_resultsource_metadata', + ($i + ? "DBIC_method_is_${type}_extra_accessor" + : "DBIC_method_is_${type}_accessor" + ), + ) + } + } + } +} + sub get_component_class { my $class = $_[0]->get_inherited($_[1]); @@ -41,8 +82,6 @@ sub get_component_class { ) { $_[0]->ensure_class_loaded($class); - mro::set_mro( $class, 'c3' ); - ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} = do { \(my $anon = 'loaded') }; }