File Coverage

blib/lib/MooseX/MethodAttributes/Role/Meta/Role.pm
Criterion Covered Total %
statement 32 32 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 41 41 100.0


line stmt bran cond sub pod time code
1             package MooseX::MethodAttributes::Role::Meta::Role;
2             # ABSTRACT: metarole role for storing code attributes
3              
4             our $VERSION = '0.30';
5              
6 21     21   594526 use Moose ();
  21         41  
  21         449  
7 21     21   107 use Moose::Util::MetaRole;
  21         36  
  21         587  
8 21     21   102 use Moose::Util qw/find_meta does_role ensure_all_roles/;
  21         31  
  21         125  
9              
10 21     21   18767 use Moose::Role;
  21         67521  
  21         106  
11              
12 21     21   112229 use MooseX::MethodAttributes ();
  21         48  
  21         583  
13 21     21   12434 use MooseX::MethodAttributes::Role ();
  21         64  
  21         543  
14              
15 21     21   163 use namespace::autoclean;
  21         43  
  21         120  
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              
53             with 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              
77             after '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?
92             around 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              
106             sub _copy_attributes {
107 14     14   760 my ($self, $thing) = @_;
108              
109 14         32 push @{ $thing->_method_attribute_list }, @{ $self->_method_attribute_list };
  14         640  
  14         678  
110 14         583 @{ $thing->_method_attribute_map }{ (keys(%{ $self->_method_attribute_map }), keys(%{ $thing->_method_attribute_map })) }
  14         646  
  14         614  
111 14         35 = (values(%{ $self->_method_attribute_map }), values(%{ $thing->_method_attribute_map }));
  14         658  
  14         747  
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.
117             package # Hide from PAUSE
118             Moose::Meta::Role::Custom::Trait::MethodAttributes;
119              
120 7     7   80632 sub register_implementation { 'MooseX::MethodAttributes::Role::Meta::Role' }
121              
122             1;
123              
124             __END__
125              
126             =pod
127              
128             =encoding UTF-8
129              
130             =head1 NAME
131              
132             MooseX::MethodAttributes::Role::Meta::Role - metarole role for storing code attributes
133              
134             =head1 VERSION
135              
136             version 0.30
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              
154             This module is a metaclass role which is applied by L<MooseX::MethodAttributes::Role>, allowing
155             you to add code attributes to methods in Moose roles.
156              
157             These attributes can then be found by introspecting the role metaclass, and are automatically copied
158             into any classes or roles that the role is composed onto.
159              
160             =head1 METHODS
161              
162             =head2 initialize
163              
164             Ensures that the package containing the role methods does the
165             L<MooseX::MethodAttributes::Role::AttrContainer> role during initialisation,
166             which in turn is responsible for capturing the method attributes on the class
167             and registering them with the metaclass.
168              
169             =head2 method_metaclass
170              
171             Wraps the normal method and ensures that the method metaclass performs the
172             L<MooseX::MethodAttributes::Role::Meta::Method> role, which allows you to
173             introspect the attributes from the method objects returned by the MOP when
174             querying the metaclass.
175              
176             =head1 CAVEATS
177              
178             =over
179              
180             =item *
181              
182             Currently roles with attributes cannot have methods excluded
183             or aliased, and will in turn confer this property onto any roles they
184             are composed onto.
185              
186             =back
187              
188             =head1 AUTHORS
189              
190             =over 4
191              
192             =item *
193              
194             Florian Ragwitz <rafl@debian.org>
195              
196             =item *
197              
198             Tomas Doran <bobtfish@bobtfish.net>
199              
200             =back
201              
202             =head1 COPYRIGHT AND LICENSE
203              
204             This software is copyright (c) 2009 by Florian Ragwitz.
205              
206             This is free software; you can redistribute it and/or modify it under
207             the same terms as the Perl 5 programming language system itself.
208              
209             =cut