local-lib5/lib/perl5/MooseX/Declare/Syntax/Keyword/Role.pm

   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