X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FMethodAttributes.pm;h=0dec0b308d2966e484714a296126a71813b2fcde;hb=1b822bd3e15476666e97d9a95754f123410b3c56;hp=6dac252815a1b42279dab3db7713a3d14a8f3db7;hpb=5f48fa565dc31b9d22762488afdec8502b8ca515;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/MethodAttributes.pm b/lib/DBIx/Class/MethodAttributes.pm index 6dac252..0dec0b3 100644 --- a/lib/DBIx/Class/MethodAttributes.pm +++ b/lib/DBIx/Class/MethodAttributes.pm @@ -1,5 +1,4 @@ -package # hide from PAUSE - DBIx::Class::MethodAttributes; +package DBIx::Class::MethodAttributes; use strict; use warnings; @@ -7,13 +6,13 @@ use warnings; use DBIx::Class::_Util qw( uniq refdesc visit_namespaces ); use Scalar::Util qw( weaken refaddr ); -use mro 'c3'; use namespace::clean; -my $attr_cref_registry; +my ( $attr_cref_registry, $attr_cache_active ); sub DBIx::Class::__Attr_iThreads_handler__::CLONE { # This is disgusting, but the best we can do without even more surgery + # Note the if() at the end - we do not run this crap if we can help it visit_namespaces( action => sub { my $pkg = shift; @@ -34,7 +33,7 @@ sub DBIx::Class::__Attr_iThreads_handler__::CLONE { } return 1; - }); + }) if $attr_cache_active; # renumber the cref registry itself %$attr_cref_registry = map { @@ -48,9 +47,16 @@ sub DBIx::Class::__Attr_iThreads_handler__::CLONE { } sub MODIFY_CODE_ATTRIBUTES { - my ($class,$code,@attrs) = @_; - $class->mk_classaccessor('__attr_cache' => {}) - unless $class->can('__attr_cache'); + my $class = shift; + my $code = shift; + + my $attrs; + $attrs->{ + $_ =~ /^[a-z]+$/ ? 'builtin' + : $_ =~ /^DBIC_/ ? 'dbic' + : 'misc' + }{$_}++ for @_; + # compaction step defined $attr_cref_registry->{$_}{weakref} or delete $attr_cref_registry->{$_} @@ -69,10 +75,49 @@ sub MODIFY_CODE_ATTRIBUTES { weaken( $attr_cref_registry->{$code}{weakref} = $code ) } - $class->__attr_cache->{$code} = [ sort( uniq( - @{ $class->__attr_cache->{$code} || [] }, - @attrs, - ))]; + + # increment the pkg gen, this ensures the sanity checkers will re-evaluate + # this class when/if the time comes + mro::method_changed_in($class) if ( + ! DBIx::Class::_ENV_::OLD_MRO + and + ( $attrs->{dbic} or $attrs->{misc} ) + ); + + + # handle legacy attrs + if( $attrs->{misc} ) { + + # if the user never tickles this - we won't have to do a gross + # symtable scan in the ithread handler above, so: + # + # User - please don't tickle this + $attr_cache_active = 1; + + $class->mk_classaccessor('__attr_cache' => {}) + unless $class->can('__attr_cache'); + + $class->__attr_cache->{$code} = [ sort( uniq( + @{ $class->__attr_cache->{$code} || [] }, + keys %{ $attrs->{misc} }, + ))]; + } + + + # handle DBIC_* attrs + if( $attrs->{dbic} ) { + my $slot = $attr_cref_registry->{$code}; + + $slot->{attrs} = [ uniq + @{ $slot->{attrs} || [] }, + grep { + $class->VALID_DBIC_CODE_ATTRIBUTE($_) + or + Carp::confess( "DBIC-specific attribute '$_' did not pass validation by $class->VALID_DBIC_CODE_ATTRIBUTE() as described in DBIx::Class::MethodAttributes" ) + } keys %{$attrs->{dbic}}, + ]; + } + # FIXME - DBIC essentially gobbles up any attribute it can lay its hands on: # decidedly not cool @@ -85,12 +130,47 @@ sub MODIFY_CODE_ATTRIBUTES { # 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 (); + # For the time being reuse the old logic for any attribute we do not have + # explicit plans for (i.e. stuff that is neither reserved, nor DBIC-internal) + # + # Pass the "builtin attrs" onwards, as the DBIC internals can't possibly handle them + return sort keys %{ $attrs->{builtin} || {} }; +} + +# Address the above FIXME halfway - if something (e.g. DBIC::Helpers) wants to +# add extra attributes - it needs to override this in its base class to allow +# for 'return 1' on the newly defined attributes +sub VALID_DBIC_CODE_ATTRIBUTE { + #my ($class, $attr) = @_; + +### +### !!! IMPORTANT !!! +### +### *DO NOT* yield to the temptation of using free-form-argument attributes. +### The technique was proven instrumental in Catalyst a decade ago, and +### was more recently revived in Sub::Attributes. Yet, while on the surface +### they seem immensely useful, per-attribute argument lists are in fact an +### architectural dead end. +### +### In other words: you are *very strongly urged* to ensure the regex below +### does not allow anything beyond qr/^ DBIC_method_is_ [A-Z_a-z0-9]+ $/x +### + + $_[1] =~ /^ DBIC_method_is_ (?: + indirect_sugar + ) $/x; } sub FETCH_CODE_ATTRIBUTES { - my ($class,$code) = @_; - @{ $class->_attr_cache->{$code} || [] } + #my ($class,$code) = @_; + + sort( + @{ $_[0]->_attr_cache->{$_[1]} || [] }, + ( defined( $attr_cref_registry->{$_[1]}{ weakref } ) + ? @{ $attr_cref_registry->{$_[1]}{attrs} || [] } + : () + ), + ) } sub _attr_cache { @@ -102,3 +182,97 @@ sub _attr_cache { } 1; + +__END__ + +=head1 NAME + +DBIx::Class::MethodAttributes - DBIC-specific handling of CODE attributes + +=head1 SYNOPSIS + + my @attrlist = attributes::get( \&My::App::Schema::Result::some_method ) + +=head1 DESCRIPTION + +This class provides the L inheritance chain with the bits +necessary for L support on methods. + +Historically DBIC has accepted any string as a C attribute and made +such strings available via the semi-private L method. This +was used for e.g. the long-deprecated L, +but also has evidence of use on both C and C. + +Starting mid-2016 DBIC treats any method attribute starting with C +as an I for various DBIC-related methods. +Unlike the general attribute naming policy, strict whitelisting is imposed +on attribute names starting with C as described in +L below. + +=head2 DBIC-specific method attributes + +The following method attributes are currently recognized under the C +prefix: + +=head3 DBIC_method_is_indirect_sugar + +The presence of this attribute indicates a helper "sugar" method. Overriding +such methods in your subclasses will be of limited success at best, as DBIC +itself and various plugins are much more likely to invoke alternative direct +call paths, bypassing your override entirely. Good examples of this are +L and L. + +=head1 METHODS + +=head2 MODIFY_CODE_ATTRIBUTES + +See L. + +=head2 FETCH_CODE_ATTRIBUTES + +See L. Always returns the combination of +all attributes: both the free-form strings registered via the +L and the DBIC-specific ones. + +=head2 VALID_DBIC_CODE_ATTRIBUTE + +=over + +=item Arguments: $attribute_string + +=item Return Value: ( true| false ) + +=back + +This method is invoked when processing each DBIC-specific attribute (the ones +starting with C). An attribute is considered invalid and an exception +is thrown unless this method returns a C value. + +=head2 _attr_cache + +=over + +=item Arguments: none + +=item Return Value: B + +=back + +The legacy method of retrieving attributes declared on DBIC methods +(L was not defined until mid-2016). This method +B, and is kept for backwards +compatibility only. + +In order to query the attributes of a particular method use +L as shown in the L. + +=head1 FURTHER QUESTIONS? + +Check the list of L. + +=head1 COPYRIGHT AND LICENSE + +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.