File Coverage

blib/lib/Moose/Meta/Role/Application.pm
Criterion Covered Total %
statement 59 59 100.0
branch 12 12 100.0
condition n/a
subroutine 22 22 100.0
pod 16 16 100.0
total 109 109 100.0


line stmt bran cond sub pod time code
1             package Moose::Meta::Role::Application;
2             our $VERSION = '2.2205';
3              
4 377     377   78584 use strict;
  377         1108  
  377         12584  
5 377     377   2259 use warnings;
  377         1096  
  377         9920  
6 377     377   2678 use metaclass;
  377         1006  
  377         2442  
7 377     377   3197 use overload ();
  377         1140  
  377         13699  
8              
9 377     377   2585 use List::Util 1.33 qw( all );
  377         9318  
  377         27513  
10              
11 377     377   3810 use Moose::Util 'throw_exception';
  377         1244  
  377         3302  
12              
13             __PACKAGE__->meta->add_attribute('method_exclusions' => (
14             init_arg => '-excludes',
15             reader => 'get_method_exclusions',
16             default => sub { [] },
17             Class::MOP::_definition_context(),
18             ));
19              
20             __PACKAGE__->meta->add_attribute('method_aliases' => (
21             init_arg => '-alias',
22             reader => 'get_method_aliases',
23             default => sub { {} },
24             Class::MOP::_definition_context(),
25             ));
26              
27             sub new {
28 1903     1903 1 8272 my ($class, %params) = @_;
29 1903         62992 $class->_new(\%params);
30             }
31              
32             sub is_method_excluded {
33 14500     14500 1 29135 my ($self, $method_name) = @_;
34 14500         26834 foreach (@{$self->get_method_exclusions}) {
  14500         516325  
35 28 100       131 return 1 if $_ eq $method_name;
36             }
37 14483         40295 return 0;
38             }
39              
40             sub is_method_aliased {
41 14486     14486 1 28460 my ($self, $method_name) = @_;
42 14486 100       564934 exists $self->get_method_aliases->{$method_name} ? 1 : 0
43             }
44              
45             sub is_aliased_method {
46 682     682 1 1810 my ($self, $method_name) = @_;
47 682         1205 my %aliased_names = reverse %{$self->get_method_aliases};
  682         24166  
48 682 100       3138 exists $aliased_names{$method_name} ? 1 : 0;
49             }
50              
51             sub apply {
52 1877     1877 1 3895 my $self = shift;
53              
54 1877         8551 $self->check_role_exclusions(@_);
55 1867         9241 $self->check_required_methods(@_);
56 1839         8414 $self->check_required_attributes(@_);
57              
58 1839         8769 $self->apply_overloading(@_);
59 1833         103353 $self->apply_attributes(@_);
60 1826         8472 $self->apply_methods(@_);
61              
62 1822         8878 $self->apply_override_method_modifiers(@_);
63              
64 1810         9673 $self->apply_before_method_modifiers(@_);
65 1810         8767 $self->apply_around_method_modifiers(@_);
66 1810         8197 $self->apply_after_method_modifiers(@_);
67             }
68              
69 1     1 1 222 sub check_role_exclusions { throw_exception( "CannotCallAnAbstractMethod" ); }
70 1     1 1 80 sub check_required_methods { throw_exception( "CannotCallAnAbstractMethod" ); }
71 1     1 1 73 sub check_required_attributes { throw_exception( "CannotCallAnAbstractMethod" ); }
72              
73 1     1 1 71 sub apply_attributes { throw_exception( "CannotCallAnAbstractMethod" ); }
74 1     1 1 72 sub apply_methods { throw_exception( "CannotCallAnAbstractMethod" ); }
75 1     1 1 74 sub apply_override_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); }
76 1     1 1 73 sub apply_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); }
77              
78 1810     1810 1 7429 sub apply_before_method_modifiers { (shift)->apply_method_modifiers('before' => @_) }
79 1810     1810 1 5721 sub apply_around_method_modifiers { (shift)->apply_method_modifiers('around' => @_) }
80 1810     1810 1 6490 sub apply_after_method_modifiers { (shift)->apply_method_modifiers('after' => @_) }
81              
82             sub apply_overloading {
83 1590     1590 1 4339 my ( $self, $role, $other ) = @_;
84              
85 1590 100       8408 return unless $role->is_overloaded;
86              
87 16 100       760 unless ( $other->is_overloaded ) {
88 15         1018 $other->set_overload_fallback_value(
89             $role->get_overload_fallback_value );
90             }
91              
92 16         573 for my $overload ( $role->get_all_overloaded_operators ) {
93 17 100       132 next if $other->has_overloaded_operator( $overload->operator );
94 16         1375 $other->add_overloaded_operator(
95             $overload->operator => $overload->clone );
96             }
97             }
98              
99             1;
100              
101             # ABSTRACT: A base class for role application
102              
103             __END__
104              
105             =pod
106              
107             =encoding UTF-8
108              
109             =head1 NAME
110              
111             Moose::Meta::Role::Application - A base class for role application
112              
113             =head1 VERSION
114              
115             version 2.2205
116              
117             =head1 DESCRIPTION
118              
119             This is the abstract base class for role applications.
120              
121             The API for this class and its subclasses still needs some
122             consideration, and is intentionally not yet documented.
123              
124             =head2 METHODS
125              
126             =over 4
127              
128             =item B<new>
129              
130             =item B<meta>
131              
132             =item B<get_method_exclusions>
133              
134             =item B<is_method_excluded>
135              
136             =item B<get_method_aliases>
137              
138             =item B<is_aliased_method>
139              
140             =item B<is_method_aliased>
141              
142             =item B<apply>
143              
144             =item B<check_role_exclusions>
145              
146             =item B<check_required_methods>
147              
148             =item B<check_required_attributes>
149              
150             =item B<apply_attributes>
151              
152             =item B<apply_methods>
153              
154             =item B<apply_overloading>
155              
156             =item B<apply_method_modifiers>
157              
158             =item B<apply_before_method_modifiers>
159              
160             =item B<apply_after_method_modifiers>
161              
162             =item B<apply_around_method_modifiers>
163              
164             =item B<apply_override_method_modifiers>
165              
166             =back
167              
168             =head1 BUGS
169              
170             See L<Moose/BUGS> for details on reporting bugs.
171              
172             =head1 AUTHORS
173              
174             =over 4
175              
176             =item *
177              
178             Stevan Little <stevan@cpan.org>
179              
180             =item *
181              
182             Dave Rolsky <autarch@urth.org>
183              
184             =item *
185              
186             Jesse Luehrs <doy@cpan.org>
187              
188             =item *
189              
190             Shawn M Moore <sartak@cpan.org>
191              
192             =item *
193              
194             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
195              
196             =item *
197              
198             Karen Etheridge <ether@cpan.org>
199              
200             =item *
201              
202             Florian Ragwitz <rafl@debian.org>
203              
204             =item *
205              
206             Hans Dieter Pearcey <hdp@cpan.org>
207              
208             =item *
209              
210             Chris Prather <chris@prather.org>
211              
212             =item *
213              
214             Matt S Trout <mstrout@cpan.org>
215              
216             =back
217              
218             =head1 COPYRIGHT AND LICENSE
219              
220             This software is copyright (c) 2006 by Infinity Interactive, Inc.
221              
222             This is free software; you can redistribute it and/or modify it under
223             the same terms as the Perl 5 programming language system itself.
224              
225             =cut