X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass.pm;h=f76419d47e00ccf80b9176885bcd65a33fd085f9;hb=5f48fa565dc31b9d22762488afdec8502b8ca515;hp=61c09b1670d0ed33b7d027a9acf248623748adc6;hpb=0130575a1a5ad9249a5cdc705c043286fabdf32c;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 61c09b1..f76419d 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -23,12 +23,9 @@ use mro 'c3'; use base qw/DBIx::Class::Componentised DBIx::Class::AccessorGroup/; use DBIx::Class::Exception; -use DBIx::Class::_Util qw( uniq refdesc visit_namespaces ); -use Scalar::Util qw( weaken refaddr ); -use namespace::clean; - -__PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames'); -__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve|^Moose::Meta::'); +__PACKAGE__->mk_classaccessor( _skip_namespace_frames => + '^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve|^Moose::Meta::' +); # FIXME - this is not really necessary, and is in # fact going to slow things down a bit @@ -44,98 +41,6 @@ BEGIN { sub component_base_class { 'DBIx::Class' } - -my $attr_cref_registry; -sub DBIx::Class::__Attr_iThreads_handler__::CLONE { - - # this is disgusting, but the best we can do without even more surgery - visit_namespaces( action => sub { - my $pkg = shift; - - # skip dangerous namespaces - return 1 if $pkg =~ /^ (?: - DB | next | B | .+? ::::ISA (?: ::CACHE ) | Class::C3 - ) $/x; - - no strict 'refs'; - - if ( - exists ${"${pkg}::"}{__cag___attr_cache} - and - ref( my $attr_stash = ${"${pkg}::__cag___attr_cache"} ) eq 'HASH' - ) { - $attr_stash->{ $attr_cref_registry->{$_}{weakref} } = delete $attr_stash->{$_} - for keys %$attr_stash; - } - - return 1; - }); - - # renumber the cref registry itself - %$attr_cref_registry = map { - ( defined $_->{weakref} ) - ? ( - # because of how __attr_cache works, ugh - "$_->{weakref}" => $_, - ) - : () - } values %$attr_cref_registry; -} - -sub MODIFY_CODE_ATTRIBUTES { - my ($class,$code,@attrs) = @_; - $class->mk_classaccessor('__attr_cache' => {}) - unless $class->can('__attr_cache'); - - # compaction step - defined $attr_cref_registry->{$_}{weakref} or delete $attr_cref_registry->{$_} - for keys %$attr_cref_registry; - - # The original API used stringification instead of refaddr - can't change that now - if( $attr_cref_registry->{$code} ) { - Carp::confess( sprintf - "Coderefs '%s' and '%s' stringify to the same value '%s': nothing will work", - refdesc($code), - refdesc($attr_cref_registry->{$code}{weakref}), - "$code" - ) if refaddr($attr_cref_registry->{$code}{weakref}) != refaddr($code); - } - else { - weaken( $attr_cref_registry->{$code}{weakref} = $code ) - } - - $class->__attr_cache->{$code} = [ sort( uniq( - @{ $class->__attr_cache->{$code} || [] }, - @attrs, - ))]; - - # FIXME - DBIC essentially gobbles up any attribute it can lay its hands on: - # decidedly not cool - # - # There should be some sort of warning on unrecognized attributes or - # somesuch... OTOH people do use things in the wild hence the plan of action - # is anything but clear :/ - # - # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/lib/DBIx/Class/Service.pm#L93-110 - # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L29 - # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L36 - # - return (); -} - -sub FETCH_CODE_ATTRIBUTES { - my ($class,$code) = @_; - @{ $class->_attr_cache->{$code} || [] } -} - -sub _attr_cache { - my $self = shift; - +{ - %{ $self->can('__attr_cache') ? $self->__attr_cache : {} }, - %{ $self->maybe::next::method || {} }, - }; -} - # *DO NOT* change this URL nor the identically named =head1 below # it is linked throughout the ecosystem sub DBIx::Class::_ENV_::HELP_URL () {