lib/Moose/Meta/Role/Application.pm

   1 package Moose::Meta::Role::Application;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 our $VERSION   = '0.72';
   8 $VERSION = eval $VERSION;
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 __PACKAGE__->meta->add_attribute('method_exclusions' => (
  12     init_arg => 'excludes',
  13     reader   => 'get_method_exclusions',
  14     default  => sub { [] }
  15 ));
  16
  17 __PACKAGE__->meta->add_attribute('method_aliases' => (
  18     init_arg => 'alias',
  19     reader   => 'get_method_aliases',
  20     default  => sub { {} }
  21 ));
  22
  23 sub new {
  24     my ($class, %params) = @_;
  25
  26     if (exists $params{excludes}) {
  27         # I wish we had coercion here :)
  28         $params{excludes} = (ref $params{excludes} eq 'ARRAY'
  29                                 ? $params{excludes}
  30                                 : [ $params{excludes} ]);
  31     }
  32
  33     $class->_new(\%params);
  34 }
  35
  36 sub is_method_excluded {
  37     my ($self, $method_name) = @_;
  38     foreach (@{$self->get_method_exclusions}) {
  39         return 1 if $_ eq $method_name;
  40     }
  41     return 0;
  42 }
  43
  44 sub is_method_aliased {
  45     my ($self, $method_name) = @_;
  46     exists $self->get_method_aliases->{$method_name} ? 1 : 0
  47 }
  48
  49 sub is_aliased_method {
  50     my ($self, $method_name) = @_;
  51     my %aliased_names = reverse %{$self->get_method_aliases};
  52     exists $aliased_names{$method_name} ? 1 : 0;
  53 }
  54
  55 sub apply {
  56     my $self = shift;
  57
  58     $self->check_role_exclusions(@_);
  59     $self->check_required_methods(@_);
  60     $self->check_required_attributes(@_);
  61
  62     $self->apply_attributes(@_);
  63     $self->apply_methods(@_);
  64
  65     $self->apply_override_method_modifiers(@_);
  66
  67     $self->apply_before_method_modifiers(@_);
  68     $self->apply_around_method_modifiers(@_);
  69     $self->apply_after_method_modifiers(@_);
  70 }
  71
  72 sub check_role_exclusions           { Carp::croak "Abstract Method" }
  73 sub check_required_methods          { Carp::croak "Abstract Method" }
  74 sub check_required_attributes       { Carp::croak "Abstract Method" }
  75
  76 sub apply_attributes                { Carp::croak "Abstract Method" }
  77 sub apply_methods                   { Carp::croak "Abstract Method" }
  78 sub apply_override_method_modifiers { Carp::croak "Abstract Method" }
  79 sub apply_method_modifiers          { Carp::croak "Abstract Method" }
  80
  81 sub apply_before_method_modifiers   { (shift)->apply_method_modifiers('before' => @_) }
  82 sub apply_around_method_modifiers   { (shift)->apply_method_modifiers('around' => @_) }
  83 sub apply_after_method_modifiers    { (shift)->apply_method_modifiers('after'  => @_) }
  84
  85 1;
  86
  87 __END__
  88
  89 =pod
  90
  91 =head1 NAME
  92
  93 Moose::Meta::Role::Application - A base class for role application
  94
  95 =head1 DESCRIPTION
  96
  97 This is the abstract base class for role applications. Role
  98 application is the logic of composing a role into something. That
  99 something could be a class, another role, or an object instance.
 100
 101 =head2 METHODS
 102
 103 =over 4
 104
 105 =item B<< Moose::Meta::Role::Application->new(%options) >>
 106
 107 This method returns a new role application. It accepts several
 108 options:
 109
 110 =over 8
 111
 112 =item * excludes
 113
 114 This is an optional array reference of methods to be excluded when
 115 applying the role.
 116
 117 =item * alias
 118
 119 This is an optional hash reference of methods to be renamed when
 120 applying the role. The keys are the original method names, and the
 121 values are the new method names.
 122
 123 =back
 124
 125 Note that the constructor does not actually take any roles as
 126 arguments.
 127
 128 =item B<< $application->get_method_exclusions >>
 129
 130 Returns an array reference containing the names of the excluded
 131 methods.
 132
 133 =item B<< $application->is_method_excluded($method_name) >>
 134
 135 Given a method name, returns true if the method is excluded.
 136
 137 =item B<< $application->get_method_aliases >>
 138
 139 Returns the hash reference of method aliases passed to the
 140 constructor.
 141
 142 =item B<< $application->is_aliased_method($method_name) >>
 143
 144 This takes the name of the original method, and returns true if it is
 145 aliased.
 146
 147 =item B<< $application->is_method_aliased($method_name) >>
 148
 149 Returns true if the method name given is being used as the I<new> name
 150 for any method.
 151
 152 =item B<< $application->apply($role, $thing) >>
 153
 154 This method implements the logic of role application by calling the
 155 various check and apply methods below. Any arguments passed to this
 156 method are simply passed on to the other methods, without any
 157 processing.
 158
 159 The first argument is always a L<Moose::Meta::Role> object, and the
 160 second is the thing to which the role is being applied.
 161
 162 In some cases, the second
 163
 164 =item B<< $application->check_role_exclusions(...) >>
 165
 166 A virtual method. Subclasses are expected to throw an error if
 167
 168 =item B<check_required_methods>
 169
 170 =item B<check_required_attributes>
 171
 172 =item B<apply_attributes>
 173
 174 =item B<apply_methods>
 175
 176 =item B<apply_method_modifiers>
 177
 178 =item B<apply_before_method_modifiers>
 179
 180 =item B<apply_after_method_modifiers>
 181
 182 =item B<apply_around_method_modifiers>
 183
 184 =item B<apply_override_method_modifiers>
 185
 186 =item B<meta>
 187
 188 =back
 189
 190 =head1 BUGS
 191
 192 All complex software has bugs lurking in it, and this module is no
 193 exception. If you find a bug please either email me, or add the bug
 194 to cpan-RT.
 195
 196 =head1 AUTHOR
 197
 198 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 199
 200 =head1 COPYRIGHT AND LICENSE
 201
 202 Copyright 2006-2009 by Infinity Interactive, Inc.
 203
 204 L<http://www.iinteractive.com>
 205
 206 This library is free software; you can redistribute it and/or modify
 207 it under the same terms as Perl itself.
 208
 209 =cut
 210