File Coverage

blib/lib/MooseX/Declare/Syntax/Keyword/Role.pm
Criterion Covered Total %
statement 38 39 97.4
branch 6 8 75.0
condition n/a
subroutine 11 12 91.6
pod 1 2 50.0
total 56 61 91.8


line stmt bran cond sub pod time code
1             package MooseX::Declare::Syntax::Keyword::Role;
2             # ABSTRACT: Role declarations
3             $MooseX::Declare::Syntax::Keyword::Role::VERSION = '0.39';
4 24     24   21657 use Moose;
  24         67  
  24         204  
5 24     24   176100 use Moose::Util qw(does_role find_meta);
  24         69  
  24         231  
6 24     24   7356 use aliased 'Parse::Method::Signatures' => 'PMS';
  24         61  
  24         212  
7 24     24   4068 use aliased 'MooseX::Declare::Syntax::MethodDeclaration';
  24         53  
  24         104  
8 24     24   3606 use aliased 'Parse::Method::Signatures::Param::Placeholder';
  24         52  
  24         100  
9 24     24   3287 use aliased 'MooseX::Declare::Context::Parameterized', 'ParameterizedCtx';
  24         61  
  24         109  
10 24     24   3054 use aliased 'MooseX::Declare::Syntax::MethodDeclaration::Parameterized', 'ParameterizedMethod';
  24         73  
  24         114  
11              
12 24     24   2512 use namespace::clean -except => 'meta';
  24         62  
  24         164  
13              
14             #pod =head1 CONSUMES
15             #pod
16             #pod =for :list
17             #pod * L<MooseX::Declare::Syntax::MooseSetup>
18             #pod * L<MooseX::Declare::Syntax::RoleApplication>
19             #pod
20             #pod =cut
21              
22             with qw(
23             MooseX::Declare::Syntax::MooseSetup
24             MooseX::Declare::Syntax::RoleApplication
25             );
26              
27             #pod =head1 MODIFIED METHODS
28             #pod
29             #pod =head2 imported_moose_symbols
30             #pod
31             #pod List Object->imported_moose_symbols ()
32             #pod
33             #pod Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
34             #pod with C<requires>, C<extends>, C<has>, C<inner> and C<super>.
35             #pod
36             #pod =cut
37              
38             around imported_moose_symbols => sub { shift->(@_), qw( requires excludes extends has inner super ) };
39              
40             #pod =head2 import_symbols_from
41             #pod
42             #pod Str Object->import_symbols_from ()
43             #pod
44             #pod Will return L<Moose::Role> instead of the default L<Moose>.
45             #pod
46             #pod =cut
47              
48             around import_symbols_from => sub {
49             my ($next, $self, $ctx) = @_;
50             return $ctx->has_parameter_signature
51             ? 'MooseX::Role::Parameterized'
52             : 'Moose::Role';
53             };
54              
55             #pod =head2 make_anon_metaclass
56             #pod
57             #pod Object Object->make_anon_metaclass ()
58             #pod
59             #pod This will return an anonymous instance of L<Moose::Meta::Role>.
60             #pod
61             #pod =cut
62              
63             around make_anon_metaclass => sub { Moose::Meta::Role->create_anon_role };
64              
65             around context_traits => sub { shift->(@_), ParameterizedCtx };
66              
67             around default_inner => sub {
68             my ($next, $self, $stack) = @_;
69             my $inner = $self->$next;
70             return $inner
71             if !@{ $stack || [] } || !$stack->[-1]->is_parameterized;
72              
73             ParameterizedMethod->meta->apply($_)
74             for grep { does_role($_, MethodDeclaration) } @{ $inner };
75              
76             return $inner;
77             };
78              
79             #pod =method generate_export
80             #pod
81             #pod CodeRef Object->generate_export ()
82             #pod
83             #pod Returns a closure with a call to L</make_anon_metaclass>.
84             #pod
85             #pod =cut
86              
87 0     0 1 0 sub generate_export { my $self = shift; sub { $self->make_anon_metaclass } }
  87     87   208  
  87         564  
88              
89             after parse_namespace_specification => sub {
90             my ($self, $ctx) = @_;
91             $ctx->strip_parameter_signature;
92             };
93              
94             after add_namespace_customizations => sub {
95             my ($self, $ctx, $package, $options) = @_;
96             $self->add_parameterized_customizations($ctx, $package, $options)
97             if $ctx->has_parameter_signature;
98             };
99              
100             sub add_parameterized_customizations {
101 1     1 0 4 my ($self, $ctx, $package, $options) = @_;
102              
103 1         3 my $sig = PMS->signature(
104 1         38 input => "(${\$ctx->parameter_signature})",
105             from_namespace => $ctx->get_curstash_name,
106             );
107 1 50       301087 confess 'Positional parameters are not allowed in parameterized roles'
108             if $sig->has_positional_params;
109              
110 2 100       1404 my @vars = map {
    50          
111 1         62 does_role($_, Placeholder)
112             ? ()
113             : {
114             var => $_->variable_name,
115             name => $_->label,
116             tc => $_->meta_type_constraint,
117             ($_->has_default_value
118             ? (default => $_->default_value)
119             : ()),
120             },
121             } $sig->named_params;
122              
123 2         7 $ctx->add_preamble_code_parts(
124             sprintf 'my (%s) = map { $_[0]->$_ } qw(%s);',
125 2         73 join(',', map { $_->{var} } @vars),
126 1         1082 join(' ', map { $_->{name} } @vars),
127             );
128              
129 1         3 for my $var (@vars) {
130             $ctx->add_parameter($var->{name} => {
131             is => 'ro',
132             isa => $var->{tc},
133             (exists $var->{default}
134 1     1   887 ? (default => sub { eval $var->{default} })
135 2 100       107 : ()),
136             });
137             }
138             }
139              
140             after handle_post_parsing => sub {
141             my ($self, $ctx, $package, $class) = @_;
142             return unless $ctx->has_parameter_signature;
143             $ctx->shadow(sub (&) {
144             my $meta = find_meta($class);
145             $meta->add_parameter($_->[0], %{ $_->[1] })
146             for $ctx->get_parameters;
147             $meta->role_generator($_[0]);
148             return $class;
149             });
150             };
151              
152             #pod =head1 SEE ALSO
153             #pod
154             #pod =for :list
155             #pod * L<MooseX::Declare>
156             #pod * L<MooseX::Declare::Syntax::Keyword::Class>
157             #pod * L<MooseX::Declare::Syntax::RoleApplication>
158             #pod * L<MooseX::Declare::Syntax::MooseSetup>
159             #pod
160             #pod =cut
161              
162             1;
163              
164             __END__
165              
166             =pod
167              
168             =encoding UTF-8
169              
170             =head1 NAME
171              
172             MooseX::Declare::Syntax::Keyword::Role - Role declarations
173              
174             =head1 VERSION
175              
176             version 0.39
177              
178             =head1 METHODS
179              
180             =head2 generate_export
181              
182             CodeRef Object->generate_export ()
183              
184             Returns a closure with a call to L</make_anon_metaclass>.
185              
186             =head1 CONSUMES
187              
188             =over 4
189              
190             =item *
191              
192             L<MooseX::Declare::Syntax::MooseSetup>
193              
194             =item *
195              
196             L<MooseX::Declare::Syntax::RoleApplication>
197              
198             =back
199              
200             =head1 MODIFIED METHODS
201              
202             =head2 imported_moose_symbols
203              
204             List Object->imported_moose_symbols ()
205              
206             Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
207             with C<requires>, C<extends>, C<has>, C<inner> and C<super>.
208              
209             =head2 import_symbols_from
210              
211             Str Object->import_symbols_from ()
212              
213             Will return L<Moose::Role> instead of the default L<Moose>.
214              
215             =head2 make_anon_metaclass
216              
217             Object Object->make_anon_metaclass ()
218              
219             This will return an anonymous instance of L<Moose::Meta::Role>.
220              
221             =head1 SEE ALSO
222              
223             =over 4
224              
225             =item *
226              
227             L<MooseX::Declare>
228              
229             =item *
230              
231             L<MooseX::Declare::Syntax::Keyword::Class>
232              
233             =item *
234              
235             L<MooseX::Declare::Syntax::RoleApplication>
236              
237             =item *
238              
239             L<MooseX::Declare::Syntax::MooseSetup>
240              
241             =back
242              
243             =head1 AUTHOR
244              
245             Florian Ragwitz <rafl@debian.org>
246              
247             =head1 COPYRIGHT AND LICENSE
248              
249             This software is copyright (c) 2008 by Florian Ragwitz.
250              
251             This is free software; you can redistribute it and/or modify it under
252             the same terms as the Perl 5 programming language system itself.
253              
254             =cut