local-lib5/lib/perl5/Catalyst/Controller/ActionRole.pm

   1 package Catalyst::Controller::ActionRole;
   2 BEGIN {
   3   $Catalyst::Controller::ActionRole::VERSION = '0.14';
   4 }
   5 # ABSTRACT: Apply roles to action instances
   6
   7 use Moose;
   8 use Class::MOP;
   9 use Catalyst::Utils;
  10 use Moose::Meta::Class;
  11 use String::RewritePrefix;
  12 use MooseX::Types::Moose qw/ArrayRef Str RoleName/;
  13 use List::Util qw(first);
  14
  15 use namespace::clean -except => 'meta';
  16
  17 extends 'Catalyst::Controller';
  18
  19
  20 __PACKAGE__->mk_classdata(qw/_action_role_prefix/);
  21 __PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]);
  22
  23
  24 has _action_role_args => (
  25     traits     => [qw(Array)],
  26     isa        => ArrayRef[Str],
  27     init_arg   => 'action_roles',
  28     default    => sub { [] },
  29     handles    => {
  30         _action_role_args => 'elements',
  31     },
  32 );
  33
  34 has _action_roles => (
  35     traits     => [qw(Array)],
  36     isa        => ArrayRef[RoleName],
  37     init_arg   => undef,
  38     lazy_build => 1,
  39     handles    => {
  40         _action_roles => 'elements',
  41     },
  42 );
  43
  44 sub _build__action_roles {
  45     my $self = shift;
  46     my @roles = $self->_expand_role_shortname($self->_action_role_args);
  47     Class::MOP::load_class($_) for @roles;
  48     return \@roles;
  49 }
  50
  51 sub BUILD {
  52     my $self = shift;
  53     # force this to run at object creation time
  54     $self->_action_roles;
  55 }
  56
  57 sub create_action {
  58     my ($self, %args) = @_;
  59
  60     my $class = exists $args{attributes}->{ActionClass}
  61         ? $args{attributes}->{ActionClass}->[0]
  62         : $self->_action_class;
  63
  64     Class::MOP::load_class($class);
  65
  66     my @roles = ($self->_action_roles, @{ $args{attributes}->{Does} || [] });
  67     if (@roles) {
  68         Class::MOP::load_class($_) for @roles;
  69         my $meta = Moose::Meta::Class->initialize($class)->create_anon_class(
  70             superclasses => [$class],
  71             roles        => \@roles,
  72             cache        => 1,
  73         );
  74         $meta->add_method(meta => sub { $meta });
  75         $class = $meta->name;
  76     }
  77
  78     return $class->new(\%args);
  79 }
  80
  81 sub _expand_role_shortname {
  82     my ($self, @shortnames) = @_;
  83     my $app = $self->_application;
  84
  85     my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::'];
  86     my @prefixes = (qq{${app}::ActionRole::}, @$prefix);
  87
  88     return String::RewritePrefix->rewrite(
  89         { ''  => sub {
  90             my $loaded = Class::MOP::load_first_existing_class(
  91                 map { "$_$_[0]" } @prefixes
  92             );
  93             return first { $loaded =~ /^$_/ }
  94               sort { length $b <=> length $a } @prefixes;
  95           },
  96           '~' => $prefixes[0],
  97           '+' => '' },
  98         @shortnames,
  99     );
 100 }
 101
 102 sub _parse_Does_attr {
 103     my ($self, $app, $name, $value) = @_;
 104     return Does => $self->_expand_role_shortname($value);
 105 }
 106
 107
 108 1;
 109
 110 __END__
 111 =pod
 112
 113 =head1 NAME
 114
 115 Catalyst::Controller::ActionRole - Apply roles to action instances
 116
 117 =head1 VERSION
 118
 119 version 0.14
 120
 121 =head1 SYNOPSIS
 122
 123     package MyApp::Controller::Foo;
 124
 125     use parent qw/Catalyst::Controller::ActionRole/;
 126
 127     sub bar : Local Does('Moo') { ... }
 128
 129 =head1 DESCRIPTION
 130
 131 This module allows to apply roles to the C<Catalyst::Action>s for different
 132 controller methods.
 133
 134 For that a C<Does> attribute is provided. That attribute takes an argument,
 135 that determines the role, which is going to be applied. If that argument is
 136 prefixed with C<+>, it is assumed to be the full name of the role. If it's
 137 prefixed with C<~>, the name of your application followed by
 138 C<::ActionRole::> is prepended. If it isn't prefixed with C<+> or C<~>,
 139 the role name will be searched for in C<@INC> according to the rules for
 140 L<role prefix searching|/ROLE PREFIX SEARCHING>.
 141
 142 Additionally it's possible to to apply roles to B<all> actions of a controller
 143 without specifying the C<Does> keyword in every action definition:
 144
 145     package MyApp::Controller::Bar
 146
 147     use parent qw/Catalyst::Controller::ActionRole/;
 148
 149     __PACKAGE__->config(
 150         action_roles => ['Foo', '~Bar'],
 151     );
 152
 153     # has Catalyst::ActionRole::Foo and MyApp::ActionRole::Bar applied
 154     # if MyApp::ActionRole::Foo exists and is loadable, it will take
 155     # precedence over Catalyst::ActionRole::Foo
 156     sub moo : Local { ... }
 157
 158 =head1 ATTRIBUTES
 159
 160 =head2 _action_role_prefix
 161
 162 This class attribute stores an array reference of role prefixes to search for
 163 role names in if they aren't prefixed with C<+> or C<~>. It defaults to
 164 C<[ 'Catalyst::ActionRole::' ]>.  See L</role prefix searching>.
 165
 166 =head2 _action_roles
 167
 168 This attribute stores an array reference of role names that will be applied to
 169 every action of this controller. It can be set by passing a C<action_roles>
 170 argument to the constructor. The same expansions as for C<Does> will be
 171 performed.
 172
 173 =head1 ROLE PREFIX SEARCHING
 174
 175 Roles specified with no prefix are looked up under a set of role prefixes.  The
 176 first prefix is always C<MyApp::ActionRole::> (with C<MyApp> replaced as
 177 appropriate for your application); the following prefixes are taken from the
 178 C<_action_role_prefix> attribute.
 179
 180 =for Pod::Coverage   BUILD
 181
 182 =head1 AUTHORS
 183
 184   Florian Ragwitz <rafl@debian.org>
 185   Hans Dieter Pearcey <hdp@weftsoar.net>
 186
 187 =head1 COPYRIGHT AND LICENSE
 188
 189 This software is copyright (c) 2010 by Florian Ragwitz.
 190
 191 This is free software; you can redistribute it and/or modify it under
 192 the same terms as the Perl 5 programming language system itself.
 193
 194 =cut
 195