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.56';
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 __PACKAGE__->meta->add_attribute('method_exclusions' => (
  11     init_arg => 'excludes',
  12     reader   => 'get_method_exclusions',
  13     default  => sub { [] }
  14 ));
  15
  16 __PACKAGE__->meta->add_attribute('method_aliases' => (
  17     init_arg => 'alias',
  18     reader   => 'get_method_aliases',
  19     default  => sub { {} }
  20 ));
  21
  22 sub new {
  23     my ($class, %params) = @_;
  24
  25     if (exists $params{excludes}) {
  26         # I wish we had coercion here :)
  27         $params{excludes} = (ref $params{excludes} eq 'ARRAY'
  28                                 ? $params{excludes}
  29                                 : [ $params{excludes} ]);
  30     }
  31
  32     $class->_new(\%params);
  33 }
  34
  35 sub is_method_excluded {
  36     my ($self, $method_name) = @_;
  37     foreach (@{$self->get_method_exclusions}) {
  38         return 1 if $_ eq $method_name;
  39     }
  40     return 0;
  41 }
  42
  43 sub is_method_aliased {
  44     my ($self, $method_name) = @_;
  45     exists $self->get_method_aliases->{$method_name} ? 1 : 0
  46 }
  47
  48 sub is_aliased_method {
  49     my ($self, $method_name) = @_;
  50     my %aliased_names = reverse %{$self->get_method_aliases};
  51     exists $aliased_names{$method_name} ? 1 : 0;
  52 }
  53
  54 sub apply {
  55     my $self = shift;
  56
  57     $self->check_role_exclusions(@_);
  58     $self->check_required_methods(@_);
  59     $self->check_required_attributes(@_);
  60
  61     $self->apply_attributes(@_);
  62     $self->apply_methods(@_);
  63
  64     $self->apply_override_method_modifiers(@_);
  65
  66     $self->apply_before_method_modifiers(@_);
  67     $self->apply_around_method_modifiers(@_);
  68     $self->apply_after_method_modifiers(@_);
  69 }
  70
  71 sub check_role_exclusions           { Carp::croak "Abstract Method" }
  72 sub check_required_methods          { Carp::croak "Abstract Method" }
  73 sub check_required_attributes       { Carp::croak "Abstract Method" }
  74
  75 sub apply_attributes                { Carp::croak "Abstract Method" }
  76 sub apply_methods                   { Carp::croak "Abstract Method" }
  77 sub apply_override_method_modifiers { Carp::croak "Abstract Method" }
  78 sub apply_method_modifiers          { Carp::croak "Abstract Method" }
  79
  80 sub apply_before_method_modifiers   { (shift)->apply_method_modifiers('before' => @_) }
  81 sub apply_around_method_modifiers   { (shift)->apply_method_modifiers('around' => @_) }
  82 sub apply_after_method_modifiers    { (shift)->apply_method_modifiers('after'  => @_) }
  83
  84 1;
  85
  86 __END__
  87
  88 =pod
  89
  90 =head1 NAME
  91
  92 Moose::Meta::Role::Application - A base class for role application
  93
  94 =head1 DESCRIPTION
  95
  96 This is the abstract base class for role applications.
  97
  98 =head2 METHODS
  99
 100 =over 4
 101
 102 =item B<new>
 103
 104 =item B<meta>
 105
 106 =item B<get_method_exclusions>
 107
 108 =item B<is_method_excluded>
 109
 110 =item B<get_method_aliases>
 111
 112 =item B<is_aliased_method>
 113
 114 =item B<is_method_aliased>
 115
 116 =item B<apply>
 117
 118 =item B<check_role_exclusions>
 119
 120 =item B<check_required_methods>
 121
 122 =item B<check_required_attributes>
 123
 124 =item B<apply_attributes>
 125
 126 =item B<apply_methods>
 127
 128 =item B<apply_method_modifiers>
 129
 130 =item B<apply_before_method_modifiers>
 131
 132 =item B<apply_after_method_modifiers>
 133
 134 =item B<apply_around_method_modifiers>
 135
 136 =item B<apply_override_method_modifiers>
 137
 138 =back
 139
 140 =head1 BUGS
 141
 142 All complex software has bugs lurking in it, and this module is no
 143 exception. If you find a bug please either email me, or add the bug
 144 to cpan-RT.
 145
 146 =head1 AUTHOR
 147
 148 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 149
 150 =head1 COPYRIGHT AND LICENSE
 151
 152 Copyright 2006-2008 by Infinity Interactive, Inc.
 153
 154 L<http://www.iinteractive.com>
 155
 156 This library is free software; you can redistribute it and/or modify
 157 it under the same terms as Perl itself.
 158
 159 =cut
 160