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.2206';
3              
4 377     377   79102 use strict;
  377         1054  
  377         12295  
5 377     377   2301 use warnings;
  377         1059  
  377         9769  
6 377     377   2600 use metaclass;
  377         1058  
  377         2344  
7 377     377   3120 use overload ();
  377         1224  
  377         13750  
8              
9 377     377   2681 use List::Util 1.33 qw( all );
  377         9601  
  377         27786  
10              
11 377     377   3759 use Moose::Util 'throw_exception';
  377         1202  
  377         3210  
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 8095 my ($class, %params) = @_;
29 1903         62160 $class->_new(\%params);
30             }
31              
32             sub is_method_excluded {
33 14500     14500 1 28111 my ($self, $method_name) = @_;
34 14500         27249 foreach (@{$self->get_method_exclusions}) {
  14500         513419  
35 28 100       118 return 1 if $_ eq $method_name;
36             }
37 14483         40341 return 0;
38             }
39              
40             sub is_method_aliased {
41 14486     14486 1 28000 my ($self, $method_name) = @_;
42 14486 100       556842 exists $self->get_method_aliases->{$method_name} ? 1 : 0
43             }
44              
45             sub is_aliased_method {
46 682     682 1 1696 my ($self, $method_name) = @_;
47 682         1242 my %aliased_names = reverse %{$self->get_method_aliases};
  682         23961  
48 682 100       3119 exists $aliased_names{$method_name} ? 1 : 0;
49             }
50              
51             sub apply {
52 1877     1877 1 3783 my $self = shift;
53              
54 1877         8278 $self->check_role_exclusions(@_);
55 1867         9056 $self->check_required_methods(@_);
56 1839         8210 $self->check_required_attributes(@_);
57              
58 1839         8302 $self->apply_overloading(@_);
59 1833         100814 $self->apply_attributes(@_);
60 1826         8295 $self->apply_methods(@_);
61              
62 1822         8772 $self->apply_override_method_modifiers(@_);
63              
64 1810         9612 $self->apply_before_method_modifiers(@_);
65 1810         8301 $self->apply_around_method_modifiers(@_);
66 1810         7901 $self->apply_after_method_modifiers(@_);
67             }
68              
69 1     1 1 251 sub check_role_exclusions { throw_exception( "CannotCallAnAbstractMethod" ); }
70 1     1 1 88 sub check_required_methods { throw_exception( "CannotCallAnAbstractMethod" ); }
71 1     1 1 75 sub check_required_attributes { throw_exception( "CannotCallAnAbstractMethod" ); }
72              
73 1     1 1 77 sub apply_attributes { throw_exception( "CannotCallAnAbstractMethod" ); }
74 1     1 1 76 sub apply_methods { throw_exception( "CannotCallAnAbstractMethod" ); }
75 1     1 1 73 sub apply_override_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); }
76 1     1 1 82 sub apply_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); }
77              
78 1810     1810 1 7301 sub apply_before_method_modifiers { (shift)->apply_method_modifiers('before' => @_) }
79 1810     1810 1 5683 sub apply_around_method_modifiers { (shift)->apply_method_modifiers('around' => @_) }
80 1810     1810 1 6406 sub apply_after_method_modifiers { (shift)->apply_method_modifiers('after' => @_) }
81              
82             sub apply_overloading {
83 1590     1590 1 4270 my ( $self, $role, $other ) = @_;
84              
85 1590 100       8231 return unless $role->is_overloaded;
86              
87 16 100       760 unless ( $other->is_overloaded ) {
88 15         1048 $other->set_overload_fallback_value(
89             $role->get_overload_fallback_value );
90             }
91              
92 16         542 for my $overload ( $role->get_all_overloaded_operators ) {
93 17 100       200 next if $other->has_overloaded_operator( $overload->operator );
94 16         1285 $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.2206
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