Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / MooseX / Declare / Syntax / Keyword / Role.pm
CommitLineData
3fea05b9 1package MooseX::Declare::Syntax::Keyword::Role;
2
3use Moose;
4use Moose::Util qw(does_role);
5use aliased 'Parse::Method::Signatures' => 'PMS';
6use aliased 'MooseX::Declare::Syntax::MethodDeclaration';
7use aliased 'Parse::Method::Signatures::Param::Placeholder';
8use aliased 'MooseX::Declare::Context::Parameterized', 'ParameterizedCtx';
9use aliased 'MooseX::Declare::Syntax::MethodDeclaration::Parameterized', 'ParameterizedMethod';
10
11use namespace::clean -except => 'meta';
12
13with qw(
14 MooseX::Declare::Syntax::MooseSetup
15 MooseX::Declare::Syntax::RoleApplication
16);
17
18around imported_moose_symbols => sub { shift->(@_), qw( requires excludes extends has inner super ) };
19
20around import_symbols_from => sub {
21 my ($next, $self, $ctx) = @_;
22 return $ctx->has_parameter_signature
23 ? 'MooseX::Role::Parameterized'
24 : 'Moose::Role';
25};
26
27around make_anon_metaclass => sub { Moose::Meta::Role->create_anon_role };
28
29around context_traits => sub { shift->(@_), ParameterizedCtx };
30
31around 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
43sub generate_export { my $self = shift; sub { $self->make_anon_metaclass } }
44
45after parse_namespace_specification => sub {
46 my ($self, $ctx) = @_;
47 $ctx->strip_parameter_signature;
48};
49
50after 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
56sub 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
95after 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
1071;
108
109=head1 NAME
110
111MooseX::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
129Returns 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
137Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
138with 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
144Will return L<Moose::Role> instead of the default L<Moose>.
145
146=head2 make_anon_metaclass
147
148 Object Object->make_anon_metaclass ()
149
150This 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
168See L<MooseX::Declare>
169
170=cut