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.65';
   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.
  98
  99 =head2 METHODS
 100
 101 =over 4
 102
 103 =item B<new>
 104
 105 =item B<meta>
 106
 107 =item B<get_method_exclusions>
 108
 109 =item B<is_method_excluded>
 110
 111 =item B<get_method_aliases>
 112
 113 =item B<is_aliased_method>
 114
 115 =item B<is_method_aliased>
 116
 117 =item B<apply>
 118
 119 =item B<check_role_exclusions>
 120
 121 =item B<check_required_methods>
 122
 123 =item B<check_required_attributes>
 124
 125 =item B<apply_attributes>
 126
 127 =item B<apply_methods>
 128
 129 =item B<apply_method_modifiers>
 130
 131 =item B<apply_before_method_modifiers>
 132
 133 =item B<apply_after_method_modifiers>
 134
 135 =item B<apply_around_method_modifiers>
 136
 137 =item B<apply_override_method_modifiers>
 138
 139 =back
 140
 141 =head1 BUGS
 142
 143 All complex software has bugs lurking in it, and this module is no
 144 exception. If you find a bug please either email me, or add the bug
 145 to cpan-RT.
 146
 147 =head1 AUTHOR
 148
 149 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 150
 151 =head1 COPYRIGHT AND LICENSE
 152
 153 Copyright 2006-2008 by Infinity Interactive, Inc.
 154
 155 L<http://www.iinteractive.com>
 156
 157 This library is free software; you can redistribute it and/or modify
 158 it under the same terms as Perl itself.
 159
 160 =cut
 161