Commit | Line | Data |
3fea05b9 |
1 | package MooseX::Declare::Syntax::Keyword::Role; |
2 | |
3 | use Moose; |
4 | use Moose::Util qw(does_role); |
5 | use aliased 'Parse::Method::Signatures' => 'PMS'; |
6 | use aliased 'MooseX::Declare::Syntax::MethodDeclaration'; |
7 | use aliased 'Parse::Method::Signatures::Param::Placeholder'; |
8 | use aliased 'MooseX::Declare::Context::Parameterized', 'ParameterizedCtx'; |
9 | use aliased 'MooseX::Declare::Syntax::MethodDeclaration::Parameterized', 'ParameterizedMethod'; |
10 | |
11 | use namespace::clean -except => 'meta'; |
12 | |
13 | with qw( |
14 | MooseX::Declare::Syntax::MooseSetup |
15 | MooseX::Declare::Syntax::RoleApplication |
16 | ); |
17 | |
18 | around imported_moose_symbols => sub { shift->(@_), qw( requires excludes extends has inner super ) }; |
19 | |
20 | around import_symbols_from => sub { |
21 | my ($next, $self, $ctx) = @_; |
22 | return $ctx->has_parameter_signature |
23 | ? 'MooseX::Role::Parameterized' |
24 | : 'Moose::Role'; |
25 | }; |
26 | |
27 | around make_anon_metaclass => sub { Moose::Meta::Role->create_anon_role }; |
28 | |
29 | around context_traits => sub { shift->(@_), ParameterizedCtx }; |
30 | |
31 | around default_inner => sub { |
32 | my ($next, $self, $stack) = @_; |
33 | my $inner = $self->$next; |
34 | return $inner |
35 | if !@{ $stack || [] } || !$stack->[-1]->is_parameterized; |
36 | |
37 | ParameterizedMethod->meta->apply($_) |
38 | for grep { does_role($_, MethodDeclaration) } @{ $inner }; |
39 | |
40 | return $inner; |
41 | }; |
42 | |
43 | sub generate_export { my $self = shift; sub { $self->make_anon_metaclass } } |
44 | |
45 | after parse_namespace_specification => sub { |
46 | my ($self, $ctx) = @_; |
47 | $ctx->strip_parameter_signature; |
48 | }; |
49 | |
50 | after add_namespace_customizations => sub { |
51 | my ($self, $ctx, $package, $options) = @_; |
52 | $self->add_parameterized_customizations($ctx, $package, $options) |
53 | if $ctx->has_parameter_signature; |
54 | }; |
55 | |
56 | sub add_parameterized_customizations { |
57 | my ($self, $ctx, $package, $options) = @_; |
58 | |
59 | my $sig = PMS->signature( |
60 | input => "(${\$ctx->parameter_signature})", |
61 | from_namespace => $ctx->get_curstash_name, |
62 | ); |
63 | confess 'Positional parameters are not allowed in parameterized roles' |
64 | if $sig->has_positional_params; |
65 | |
66 | my @vars = map { |
67 | does_role($_, Placeholder) |
68 | ? () |
69 | : { |
70 | var => $_->variable_name, |
71 | name => $_->label, |
72 | tc => $_->meta_type_constraint, |
73 | ($_->has_default_value |
74 | ? (default => $_->default_value) |
75 | : ()), |
76 | }, |
77 | } $sig->named_params; |
78 | |
79 | $ctx->add_preamble_code_parts( |
80 | sprintf 'my (%s) = map { $_[0]->$_ } qw(%s);', |
81 | join(',', map { $_->{var} } @vars), |
82 | join(' ', map { $_->{name} } @vars), |
83 | ); |
84 | |
85 | for my $var (@vars) { |
86 | $ctx->add_parameter($var->{name} => { |
87 | isa => $var->{tc}, |
88 | (exists $var->{default} |
89 | ? (default => sub { eval $var->{default} }) |
90 | : ()), |
91 | }); |
92 | } |
93 | } |
94 | |
95 | after handle_post_parsing => sub { |
96 | my ($self, $ctx, $package, $class) = @_; |
97 | return unless $ctx->has_parameter_signature; |
98 | $ctx->shadow(sub (&) { |
99 | my $meta = Class::MOP::class_of($class); |
100 | $meta->add_parameter($_->[0], %{ $_->[1] }) |
101 | for $ctx->get_parameters; |
102 | $meta->role_generator($_[0]); |
103 | return $class; |
104 | }); |
105 | }; |
106 | |
107 | 1; |
108 | |
109 | =head1 NAME |
110 | |
111 | MooseX::Declare::Syntax::Keyword::Role - Role declarations |
112 | |
113 | =head1 CONSUMES |
114 | |
115 | =over |
116 | |
117 | =item * L<MooseX::Declare::Syntax::MooseSetup> |
118 | |
119 | =item * L<MooseX::Declare::Syntax::RoleApplication> |
120 | |
121 | =back |
122 | |
123 | =head1 METHODS |
124 | |
125 | =head2 generate_export |
126 | |
127 | CodeRef Object->generate_export () |
128 | |
129 | Returns a closure with a call to L</make_anon_metaclass>. |
130 | |
131 | =head1 MODIFIED METHODS |
132 | |
133 | =head2 imported_moose_symbols |
134 | |
135 | List Object->imported_moose_symbols () |
136 | |
137 | Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols> |
138 | with C<requires>, C<extends>, C<has>, C<inner> and C<super>. |
139 | |
140 | =head2 import_symbols_from |
141 | |
142 | Str Object->import_symbols_from () |
143 | |
144 | Will return L<Moose::Role> instead of the default L<Moose>. |
145 | |
146 | =head2 make_anon_metaclass |
147 | |
148 | Object Object->make_anon_metaclass () |
149 | |
150 | This will return an anonymous instance of L<Moose::Meta::Role>. |
151 | |
152 | =head1 SEE ALSO |
153 | |
154 | =over |
155 | |
156 | =item * L<MooseX::Declare> |
157 | |
158 | =item * L<MooseX::Declare::Syntax::Keyword::Class> |
159 | |
160 | =item * L<MooseX::Declare::Syntax::RoleApplication> |
161 | |
162 | =item * L<MooseX::Declare::Syntax::MooseSetup> |
163 | |
164 | =back |
165 | |
166 | =head1 AUTHOR, COPYRIGHT & LICENSE |
167 | |
168 | See L<MooseX::Declare> |
169 | |
170 | =cut |