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