1package MooseX::MethodAttributes::Role::Meta::Role; 2# ABSTRACT: metarole role for storing code attributes 3 4our $VERSION = '0.32'; 5 6use Moose (); 7use Moose::Util::MetaRole; 8use Moose::Util qw/find_meta does_role ensure_all_roles/; 9 10use Moose::Role; 11 12use MooseX::MethodAttributes (); 13use MooseX::MethodAttributes::Role (); 14 15use namespace::autoclean; 16 17#pod =head1 SYNOPSIS 18#pod 19#pod package MyRole; 20#pod use MooseX::MethodAttributes::Role; 21#pod 22#pod sub foo : Bar Baz('corge') { ... } 23#pod 24#pod package MyClass 25#pod use Moose; 26#pod 27#pod with 'MyRole'; 28#pod 29#pod my $attrs = MyClass->meta->get_method('foo')->attributes; # ["Bar", "Baz('corge')"] 30#pod 31#pod =head1 DESCRIPTION 32#pod 33#pod This module is a metaclass role which is applied by L<MooseX::MethodAttributes::Role>, allowing 34#pod you to add code attributes to methods in Moose roles. 35#pod 36#pod These attributes can then be found by introspecting the role metaclass, and are automatically copied 37#pod into any classes or roles that the role is composed onto. 38#pod 39#pod =head1 CAVEATS 40#pod 41#pod =over 42#pod 43#pod =item * 44#pod 45#pod Currently roles with attributes cannot have methods excluded 46#pod or aliased, and will in turn confer this property onto any roles they 47#pod are composed onto. 48#pod 49#pod =back 50#pod 51#pod =cut 52 53with qw/ 54 MooseX::MethodAttributes::Role::Meta::Map 55 MooseX::MethodAttributes::Role::Meta::Role::Application 56/; 57 58$Moose::VERSION >= 0.9301 59 ? around composition_class_roles => sub { 60 my ($orig, $self) = @_; 61 return $self->$orig, 62 'MooseX::MethodAttributes::Role::Meta::Role::Application::Summation'; 63 } 64 : has '+composition_class_roles' => ( 65 default => sub { [ 'MooseX::MethodAttributes::Role::Meta::Role::Application::Summation' ] }, 66 ); 67 68#pod =method initialize 69#pod 70#pod Ensures that the package containing the role methods does the 71#pod L<MooseX::MethodAttributes::Role::AttrContainer> role during initialisation, 72#pod which in turn is responsible for capturing the method attributes on the class 73#pod and registering them with the metaclass. 74#pod 75#pod =cut 76 77after 'initialize' => sub { 78 my ($self, $class, %args) = @_; 79 ensure_all_roles($class, 'MooseX::MethodAttributes::Role::AttrContainer'); 80}; 81 82#pod =method method_metaclass 83#pod 84#pod Wraps the normal method and ensures that the method metaclass performs the 85#pod L<MooseX::MethodAttributes::Role::Meta::Method> role, which allows you to 86#pod introspect the attributes from the method objects returned by the MOP when 87#pod querying the metaclass. 88#pod 89#pod =cut 90 91# FIXME - Skip this logic if the method metaclass already does the right role? 92around method_metaclass => sub { 93 my $orig = shift; 94 my $self = shift; 95 return $self->$orig(@_) if scalar @_; 96 Moose::Meta::Class->create_anon_class( 97 superclasses => [ $self->$orig ], 98 roles => [qw/ 99 MooseX::MethodAttributes::Role::Meta::Method 100 /], 101 cache => 1, 102 )->name(); 103}; 104 105 106sub _copy_attributes { 107 my ($self, $thing) = @_; 108 109 push @{ $thing->_method_attribute_list }, @{ $self->_method_attribute_list }; 110 @{ $thing->_method_attribute_map }{ (keys(%{ $self->_method_attribute_map }), keys(%{ $thing->_method_attribute_map })) } 111 = (values(%{ $self->_method_attribute_map }), values(%{ $thing->_method_attribute_map })); 112}; 113 114# This allows you to say use Moose::Role -traits => 'MethodAttributes' 115# This is replaced by MooseX::MethodAttributes::Role, and this trait registration 116# is now only present for backwards compatibility reasons. 117package # Hide from PAUSE 118 Moose::Meta::Role::Custom::Trait::MethodAttributes; 119 120sub register_implementation { 'MooseX::MethodAttributes::Role::Meta::Role' } 121 1221; 123 124__END__ 125 126=pod 127 128=encoding UTF-8 129 130=head1 NAME 131 132MooseX::MethodAttributes::Role::Meta::Role - metarole role for storing code attributes 133 134=head1 VERSION 135 136version 0.32 137 138=head1 SYNOPSIS 139 140 package MyRole; 141 use MooseX::MethodAttributes::Role; 142 143 sub foo : Bar Baz('corge') { ... } 144 145 package MyClass 146 use Moose; 147 148 with 'MyRole'; 149 150 my $attrs = MyClass->meta->get_method('foo')->attributes; # ["Bar", "Baz('corge')"] 151 152=head1 DESCRIPTION 153 154This module is a metaclass role which is applied by L<MooseX::MethodAttributes::Role>, allowing 155you to add code attributes to methods in Moose roles. 156 157These attributes can then be found by introspecting the role metaclass, and are automatically copied 158into any classes or roles that the role is composed onto. 159 160=head1 METHODS 161 162=head2 initialize 163 164Ensures that the package containing the role methods does the 165L<MooseX::MethodAttributes::Role::AttrContainer> role during initialisation, 166which in turn is responsible for capturing the method attributes on the class 167and registering them with the metaclass. 168 169=head2 method_metaclass 170 171Wraps the normal method and ensures that the method metaclass performs the 172L<MooseX::MethodAttributes::Role::Meta::Method> role, which allows you to 173introspect the attributes from the method objects returned by the MOP when 174querying the metaclass. 175 176=head1 CAVEATS 177 178=over 179 180=item * 181 182Currently roles with attributes cannot have methods excluded 183or aliased, and will in turn confer this property onto any roles they 184are composed onto. 185 186=back 187 188=head1 SUPPORT 189 190Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-MethodAttributes> 191(or L<bug-MooseX-MethodAttributes@rt.cpan.org|mailto:bug-MooseX-MethodAttributes@rt.cpan.org>). 192 193There is also a mailing list available for users of this distribution, at 194L<http://lists.perl.org/list/moose.html>. 195 196There is also an irc channel available for users of this distribution, at 197L<C<#moose> on C<irc.perl.org>|irc://irc.perl.org/#moose>. 198 199=head1 AUTHORS 200 201=over 4 202 203=item * 204 205Florian Ragwitz <rafl@debian.org> 206 207=item * 208 209Tomas Doran <bobtfish@bobtfish.net> 210 211=back 212 213=head1 COPYRIGHT AND LICENCE 214 215This software is copyright (c) 2009 by Florian Ragwitz. 216 217This is free software; you can redistribute it and/or modify it under 218the same terms as the Perl 5 programming language system itself. 219 220=cut 221