← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:12 2010

File /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToRole.pm
Statements Executed 19
Total Time 0.001152 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMoose::Meta::Role::Application::ToRole::::BEGINMoose::Meta::Role::Application::ToRole::BEGIN
0000s0sMoose::Meta::Role::Application::ToRole::::applyMoose::Meta::Role::Application::ToRole::apply
0000s0sMoose::Meta::Role::Application::ToRole::::apply_attributesMoose::Meta::Role::Application::ToRole::apply_attributes
0000s0sMoose::Meta::Role::Application::ToRole::::apply_method_modifiersMoose::Meta::Role::Application::ToRole::apply_method_modifiers
0000s0sMoose::Meta::Role::Application::ToRole::::apply_methodsMoose::Meta::Role::Application::ToRole::apply_methods
0000s0sMoose::Meta::Role::Application::ToRole::::apply_override_method_modifiersMoose::Meta::Role::Application::ToRole::apply_override_method_modifiers
0000s0sMoose::Meta::Role::Application::ToRole::::check_required_attributesMoose::Meta::Role::Application::ToRole::check_required_attributes
0000s0sMoose::Meta::Role::Application::ToRole::::check_required_methodsMoose::Meta::Role::Application::ToRole::check_required_methods
0000s0sMoose::Meta::Role::Application::ToRole::::check_role_exclusionsMoose::Meta::Role::Application::ToRole::check_role_exclusions
LineStmts.Exclusive
Time
Avg.Code
1package Moose::Meta::Role::Application::ToRole;
2
3327µs9µsuse strict;
# spent 9µs making 1 call to strict::import
4332µs10µsuse warnings;
# spent 21µs making 1 call to warnings::import
5340µs13µsuse metaclass;
# spent 813µs making 1 call to metaclass::import
6
7372µs24µsuse Scalar::Util 'blessed';
# spent 46µs making 1 call to Exporter::import
8
91800ns800nsour $VERSION = '1.15';
10129µs29µs$VERSION = eval $VERSION;
111600ns600nsour $AUTHORITY = 'cpan:STEVAN';
12
133942µs314µsuse base 'Moose::Meta::Role::Application';
# spent 63µs making 1 call to base::import
14
15sub apply {
16 my ($self, $role1, $role2) = @_;
17 $self->SUPER::apply($role1, $role2);
18 $role2->add_role($role1);
19}
20
21sub check_role_exclusions {
22 my ($self, $role1, $role2) = @_;
23 if ( $role2->excludes_role($role1->name) ) {
24 require Moose;
25 Moose->throw_error("Conflict detected: " . $role2->name . " excludes role '" . $role1->name . "'");
26 }
27 foreach my $excluded_role_name ($role1->get_excluded_roles_list) {
28 if ( $role2->does_role($excluded_role_name) ) {
29 require Moose;
30 Moose->throw_error("The class " . $role2->name . " does the excluded role '$excluded_role_name'");
31 }
32 $role2->add_excluded_roles($excluded_role_name);
33 }
34}
35
36sub check_required_methods {
37 my ($self, $role1, $role2) = @_;
38 foreach my $required_method ($role1->get_required_method_list) {
39 my $required_method_name = $required_method->name;
40
41 next if $self->is_aliased_method($required_method_name);
42
43 $role2->add_required_methods($required_method)
44 unless $role2->find_method_by_name($required_method_name);
45 }
46}
47
48sub check_required_attributes {
49
50}
51
52sub apply_attributes {
53 my ($self, $role1, $role2) = @_;
54 foreach my $attribute_name ($role1->get_attribute_list) {
55 # it if it has one already
56 if ($role2->has_attribute($attribute_name) &&
57 # make sure we haven't seen this one already too
58 $role2->get_attribute($attribute_name) != $role1->get_attribute($attribute_name)) {
59
60 my $role2_name = $role2->name;
61
62 require Moose;
63 Moose->throw_error( "Role '"
64 . $role1->name
65 . "' has encountered an attribute conflict"
66 . " while being composed into '$role2_name'."
67 . " This is a fatal error and cannot be disambiguated."
68 . " The conflicting attribute is named '$attribute_name'." );
69 }
70 else {
71 $role2->add_attribute(
72 $role1->get_attribute($attribute_name)->clone
73 );
74 }
75 }
76}
77
78sub apply_methods {
79 my ( $self, $role1, $role2 ) = @_;
80 foreach my $method ( $role1->_get_local_methods ) {
81
82 my $method_name = $method->name;
83
84 next if $method->isa('Class::MOP::Method::Meta');
85
86 unless ( $self->is_method_excluded($method_name) ) {
87
88 my $role2_method = $role2->get_method($method_name);
89 if ( $role2_method
90 && $role2_method->body != $method->body ) {
91
92 # method conflicts between roles result in the method becoming
93 # a requirement
94 $role2->add_conflicting_method(
95 name => $method_name,
96 roles => [ $role1->name, $role2->name ],
97 );
98 }
99 else {
100 $role2->add_method(
101 $method_name,
102 $method,
103 );
104 }
105 }
106
107 next unless $self->is_method_aliased($method_name);
108
109 my $aliased_method_name = $self->get_method_aliases->{$method_name};
110
111 my $role2_method = $role2->get_method($aliased_method_name);
112
113 if ( $role2_method
114 && $role2_method->body != $method->body ) {
115
116 require Moose;
117 Moose->throw_error(
118 "Cannot create a method alias if a local method of the same name exists"
119 );
120 }
121
122 $role2->add_method(
123 $aliased_method_name,
124 $role1->get_method($method_name)
125 );
126
127 if ( !$role2->has_method($method_name) ) {
128 $role2->add_required_methods($method_name)
129 unless $self->is_method_excluded($method_name);
130 }
131 }
132}
133
134sub apply_override_method_modifiers {
135 my ($self, $role1, $role2) = @_;
136 foreach my $method_name ($role1->get_method_modifier_list('override')) {
137 # it if it has one already then ...
138 if ($role2->has_method($method_name)) {
139 # if it is being composed into another role
140 # we have a conflict here, because you cannot
141 # combine an overridden method with a locally
142 # defined one
143 require Moose;
144 Moose->throw_error("Role '" . $role1->name . "' has encountered an 'override' method conflict " .
145 "during composition (A local method of the same name as been found). This " .
146 "is fatal error.");
147 }
148 else {
149 # if we are a role, we need to make sure
150 # we dont have a conflict with the role
151 # we are composing into
152 if ($role2->has_override_method_modifier($method_name) &&
153 $role2->get_override_method_modifier($method_name) != $role2->get_override_method_modifier($method_name)) {
154
155 require Moose;
156 Moose->throw_error("Role '" . $role1->name . "' has encountered an 'override' method conflict " .
157 "during composition (Two 'override' methods of the same name encountered). " .
158 "This is fatal error.");
159 }
160 else {
161 # if there is no conflict,
162 # just add it to the role
163 $role2->add_override_method_modifier(
164 $method_name,
165 $role1->get_override_method_modifier($method_name)
166 );
167 }
168 }
169 }
170}
171
172sub apply_method_modifiers {
173 my ($self, $modifier_type, $role1, $role2) = @_;
174 my $add = "add_${modifier_type}_method_modifier";
175 my $get = "get_${modifier_type}_method_modifiers";
176 foreach my $method_name ($role1->get_method_modifier_list($modifier_type)) {
177 $role2->$add(
178 $method_name,
179 $_
180 ) foreach $role1->$get($method_name);
181 }
182}
183
184
18519µs9µs1;
186
187__END__
188
189=pod
190
191=head1 NAME
192
193Moose::Meta::Role::Application::ToRole - Compose a role into another role
194
195=head1 DESCRIPTION
196
197=head2 METHODS
198
199=over 4
200
201=item B<new>
202
203=item B<meta>
204
205=item B<apply>
206
207=item B<check_role_exclusions>
208
209=item B<check_required_methods>
210
211=item B<check_required_attributes>
212
213=item B<apply_attributes>
214
215=item B<apply_methods>
216
217=item B<apply_method_modifiers>
218
219=item B<apply_override_method_modifiers>
220
221=back
222
223=head1 BUGS
224
225See L<Moose/BUGS> for details on reporting bugs.
226
227=head1 AUTHOR
228
229Stevan Little E<lt>stevan@iinteractive.comE<gt>
230
231=head1 COPYRIGHT AND LICENSE
232
233Copyright 2006-2010 by Infinity Interactive, Inc.
234
235L<http://www.iinteractive.com>
236
237This library is free software; you can redistribute it and/or modify
238it under the same terms as Perl itself.
239
240=cut
241