Remove references to
[gitmo/Moose.git] / lib / Moose / Meta / Role / Application / ToRole.pm
CommitLineData
fb1e11d5 1package Moose::Meta::Role::Application::ToRole;
2
3use strict;
4use warnings;
5use metaclass;
6
7use Carp 'confess';
8use Scalar::Util 'blessed';
9
a7e9b05b 10our $VERSION = '0.55_04';
75b95414 11$VERSION = eval $VERSION;
fb1e11d5 12our $AUTHORITY = 'cpan:STEVAN';
13
14use base 'Moose::Meta::Role::Application';
15
1c9db35c 16sub apply {
c4538447 17 my ($self, $role1, $role2) = @_;
18 $self->SUPER::apply($role1, $role2);
19 $role2->add_role($role1);
1c9db35c 20}
21
22sub check_role_exclusions {
23 my ($self, $role1, $role2) = @_;
24 confess "Conflict detected: " . $role2->name . " excludes role '" . $role1->name . "'"
25 if $role2->excludes_role($role1->name);
26 foreach my $excluded_role_name ($role1->get_excluded_roles_list) {
27 confess "The class " . $role2->name . " does the excluded role '$excluded_role_name'"
28 if $role2->does_role($excluded_role_name);
29 $role2->add_excluded_roles($excluded_role_name);
30 }
31}
32
33sub check_required_methods {
34 my ($self, $role1, $role2) = @_;
35 foreach my $required_method_name ($role1->get_required_method_list) {
3e19778d 36
37 next if $self->is_aliased_method($required_method_name);
38
1c9db35c 39 $role2->add_required_methods($required_method_name)
40 unless $role2->find_method_by_name($required_method_name);
41 }
42}
43
709c321c 44sub check_required_attributes {
45
46}
47
1c9db35c 48sub apply_attributes {
49 my ($self, $role1, $role2) = @_;
50 foreach my $attribute_name ($role1->get_attribute_list) {
51 # it if it has one already
52 if ($role2->has_attribute($attribute_name) &&
53 # make sure we haven't seen this one already too
54 $role2->get_attribute($attribute_name) != $role1->get_attribute($attribute_name)) {
55 confess "Role '" . $role1->name . "' has encountered an attribute conflict " .
56 "during composition. This is fatal error and cannot be disambiguated.";
57 }
58 else {
59 $role2->add_attribute(
60 $attribute_name,
61 $role1->get_attribute($attribute_name)
62 );
63 }
64 }
65}
66
67sub apply_methods {
68 my ($self, $role1, $role2) = @_;
69 foreach my $method_name ($role1->get_method_list) {
c4538447 70
43a41ede 71 next if $self->is_method_excluded($method_name);
db9476b1 72
73 if ($self->is_method_aliased($method_name)) {
74 my $aliased_method_name = $self->get_method_aliases->{$method_name};
75 # it if it has one already
76 if ($role2->has_method($aliased_method_name) &&
77 # and if they are not the same thing ...
78 $role2->get_method($aliased_method_name)->body != $role1->get_method($method_name)->body) {
79 confess "Cannot create a method alias if a local method of the same name exists";
80 }
81
82 $role2->alias_method(
83 $aliased_method_name,
84 $role1->get_method($method_name)
85 );
86
87 if (!$role2->has_method($method_name)) {
88 $role2->add_required_methods($method_name);
89 }
90
91 next;
92 }
3e19778d 93
1c9db35c 94 # it if it has one already
95 if ($role2->has_method($method_name) &&
96 # and if they are not the same thing ...
97 $role2->get_method($method_name)->body != $role1->get_method($method_name)->body) {
98 # method conflicts between roles result
99 # in the method becoming a requirement
100 $role2->add_required_methods($method_name);
101 }
102 else {
103 # add it, although it could be overriden
104 $role2->alias_method(
105 $method_name,
43a41ede 106 $role1->get_method($method_name)
1c9db35c 107 );
43a41ede 108
1c9db35c 109 }
43a41ede 110
1c9db35c 111 }
112}
113
114sub apply_override_method_modifiers {
115 my ($self, $role1, $role2) = @_;
116 foreach my $method_name ($role1->get_method_modifier_list('override')) {
117 # it if it has one already then ...
118 if ($role2->has_method($method_name)) {
119 # if it is being composed into another role
120 # we have a conflict here, because you cannot
121 # combine an overriden method with a locally
122 # defined one
123 confess "Role '" . $role1->name . "' has encountered an 'override' method conflict " .
124 "during composition (A local method of the same name as been found). This " .
125 "is fatal error.";
126 }
127 else {
128 # if we are a role, we need to make sure
129 # we dont have a conflict with the role
130 # we are composing into
131 if ($role2->has_override_method_modifier($method_name) &&
132 $role2->get_override_method_modifier($method_name) != $role2->get_override_method_modifier($method_name)) {
133 confess "Role '" . $role1->name . "' has encountered an 'override' method conflict " .
134 "during composition (Two 'override' methods of the same name encountered). " .
135 "This is fatal error.";
136 }
137 else {
138 # if there is no conflict,
139 # just add it to the role
140 $role2->add_override_method_modifier(
141 $method_name,
142 $role1->get_override_method_modifier($method_name)
143 );
144 }
145 }
146 }
147}
148
149sub apply_method_modifiers {
150 my ($self, $modifier_type, $role1, $role2) = @_;
151 my $add = "add_${modifier_type}_method_modifier";
152 my $get = "get_${modifier_type}_method_modifiers";
153 foreach my $method_name ($role1->get_method_modifier_list($modifier_type)) {
154 $role2->$add(
155 $method_name,
156 $_
157 ) foreach $role1->$get($method_name);
158 }
159}
160
1c9db35c 161
fb1e11d5 1621;
163
164__END__
165
166=pod
167
168=head1 NAME
169
ab76842e 170Moose::Meta::Role::Application::ToRole - Compose a role into another role
fb1e11d5 171
172=head1 DESCRIPTION
173
174=head2 METHODS
175
176=over 4
177
178=item B<new>
179
180=item B<meta>
181
1c9db35c 182=item B<apply>
183
709c321c 184=item B<check_role_exclusions>
185
1c9db35c 186=item B<check_required_methods>
187
709c321c 188=item B<check_required_attributes>
1c9db35c 189
190=item B<apply_attributes>
191
192=item B<apply_methods>
193
194=item B<apply_method_modifiers>
195
1c9db35c 196=item B<apply_override_method_modifiers>
197
fb1e11d5 198=back
199
200=head1 BUGS
201
202All complex software has bugs lurking in it, and this module is no
203exception. If you find a bug please either email me, or add the bug
204to cpan-RT.
205
206=head1 AUTHOR
207
208Stevan Little E<lt>stevan@iinteractive.comE<gt>
209
210=head1 COPYRIGHT AND LICENSE
211
778db3ac 212Copyright 2006-2008 by Infinity Interactive, Inc.
fb1e11d5 213
214L<http://www.iinteractive.com>
215
216This library is free software; you can redistribute it and/or modify
217it under the same terms as Perl itself.
218
219=cut
220