Commit | Line | Data |
71e7b544 |
1 | package Mouse::Meta::Role::Composite; |
5af36247 |
2 | use Mouse::Util; # enables strict and warnings |
71e7b544 |
3 | use Mouse::Meta::Role; |
823419c5 |
4 | use Mouse::Meta::Role::Application; |
71e7b544 |
5 | our @ISA = qw(Mouse::Meta::Role); |
6 | |
823419c5 |
7 | sub get_method_list { |
71e7b544 |
8 | my($self) = @_; |
9 | return keys %{ $self->{methods} }; |
10 | } |
11 | |
12 | sub add_method { |
13 | my($self, $method_name, $code, $role) = @_; |
14 | |
15 | if( ($self->{methods}{$method_name} || 0) == $code){ |
16 | # This role already has the same method. |
17 | return; |
18 | } |
19 | |
a062712d |
20 | if($method_name eq 'meta'){ |
21 | $self->SUPER::add_method($method_name => $code); |
22 | } |
23 | else{ |
24 | # no need to add a subroutine to the stash |
71e7b544 |
25 | my $roles = $self->{composed_roles_by_method}{$method_name} ||= []; |
26 | push @{$roles}, $role; |
27 | if(@{$roles} > 1){ |
28 | $self->{conflicting_methods}{$method_name}++; |
29 | } |
a062712d |
30 | $self->{methods}{$method_name} = $code; |
71e7b544 |
31 | } |
71e7b544 |
32 | return; |
33 | } |
34 | |
35 | sub get_method_body { |
36 | my($self, $method_name) = @_; |
37 | return $self->{methods}{$method_name}; |
38 | } |
39 | |
40 | sub has_method { |
41 | # my($self, $method_name) = @_; |
823419c5 |
42 | return 0; # to fool apply_methods() in combine() |
71e7b544 |
43 | } |
44 | |
823419c5 |
45 | sub has_attribute { |
71e7b544 |
46 | # my($self, $method_name) = @_; |
823419c5 |
47 | return 0; # to fool appply_attributes() in combine() |
71e7b544 |
48 | } |
49 | |
823419c5 |
50 | sub has_override_method_modifier { |
71e7b544 |
51 | # my($self, $method_name) = @_; |
823419c5 |
52 | return 0; # to fool apply_modifiers() in combine() |
71e7b544 |
53 | } |
54 | |
823419c5 |
55 | sub add_attribute { |
2053291d |
56 | my $self = shift; |
57 | my $attr_name = shift; |
58 | my $spec = (@_ == 1 ? $_[0] : {@_}); |
71e7b544 |
59 | |
60 | my $existing = $self->{attributes}{$attr_name}; |
61 | if($existing && $existing != $spec){ |
62 | $self->throw_error("We have encountered an attribute conflict with '$attr_name' " |
63 | . "during composition. This is fatal error and cannot be disambiguated."); |
64 | } |
65 | $self->SUPER::add_attribute($attr_name, $spec); |
66 | return; |
67 | } |
68 | |
823419c5 |
69 | sub add_override_method_modifier { |
71e7b544 |
70 | my($self, $method_name, $code) = @_; |
71 | |
72 | my $existing = $self->{override_method_modifiers}{$method_name}; |
73 | if($existing && $existing != $code){ |
74 | $self->throw_error( "We have encountered an 'override' method conflict with '$method_name' during " |
75 | . "composition (Two 'override' methods of the same name encountered). " |
76 | . "This is fatal error.") |
77 | } |
78 | $self->SUPER::add_override_method_modifier($method_name, $code); |
79 | return; |
80 | } |
81 | |
823419c5 |
82 | sub apply { |
83 | my $self = shift; |
84 | my $consumer = shift; |
71e7b544 |
85 | |
823419c5 |
86 | Mouse::Meta::Role::Application::RoleSummation->new(@_)->apply($self, $consumer); |
87 | return; |
88 | } |
89 | |
90 | package Mouse::Meta::Role::Application::RoleSummation; |
91 | our @ISA = qw(Mouse::Meta::Role::Application); |
71e7b544 |
92 | |
823419c5 |
93 | sub apply_methods { |
94 | my($self, $role, $consumer, @extra) = @_; |
95 | |
96 | if(exists $role->{conflicting_methods}){ |
45f22b92 |
97 | my $consumer_class_name = $consumer->name; |
71e7b544 |
98 | |
837d9c57 |
99 | my @conflicting = grep{ !$consumer_class_name->can($_) } |
823419c5 |
100 | keys %{ $role->{conflicting_methods} }; |
71e7b544 |
101 | |
837d9c57 |
102 | if(@conflicting) { |
103 | my $method_name_conflict = (@conflicting == 1 |
104 | ? 'a method name conflict' |
105 | : 'method name conflicts'); |
106 | |
71e7b544 |
107 | my %seen; |
aba0f138 |
108 | my $roles = Mouse::Util::quoted_english_list( |
5af36247 |
109 | grep{ !$seen{$_}++ } # uniq |
110 | map { $_->name } |
837d9c57 |
111 | map { @{$_} } |
112 | @{ $role->{composed_roles_by_method} }{@conflicting} |
71e7b544 |
113 | ); |
114 | |
837d9c57 |
115 | $self->throw_error(sprintf |
116 | q{Due to %s in roles %s,} |
117 | . q{ the method%s %s must be implemented or excluded by '%s'}, |
118 | $method_name_conflict, |
119 | $roles, |
120 | (@conflicting > 1 ? 's' : ''), |
121 | Mouse::Util::quoted_english_list(@conflicting), |
122 | $consumer_class_name); |
71e7b544 |
123 | } |
124 | } |
125 | |
823419c5 |
126 | $self->SUPER::apply_methods($role, $consumer, @extra); |
71e7b544 |
127 | return; |
128 | } |
823419c5 |
129 | |
130 | package Mouse::Meta::Role::Composite; |
71e7b544 |
131 | 1; |
132 | __END__ |
133 | |
a25ca8d6 |
134 | =head1 NAME |
135 | |
136 | Mouse::Meta::Role::Composite - An object to represent the set of roles |
137 | |
138 | =head1 VERSION |
139 | |
86eb0b5e |
140 | This document describes Mouse version 0.70 |
a25ca8d6 |
141 | |
142 | =head1 SEE ALSO |
143 | |
144 | L<Moose::Meta::Role::Composite> |
145 | |
146 | =cut |