Changelogging
[gitmo/Mouse.git] / lib / Mouse / Meta / Role / Composite.pm
CommitLineData
71e7b544 1package Mouse::Meta::Role::Composite;
5af36247 2use Mouse::Util; # enables strict and warnings
71e7b544 3use Mouse::Meta::Role;
823419c5 4use Mouse::Meta::Role::Application;
71e7b544 5our @ISA = qw(Mouse::Meta::Role);
6
823419c5 7sub get_method_list {
71e7b544 8 my($self) = @_;
9 return keys %{ $self->{methods} };
10}
11
12sub 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
35sub get_method_body {
36 my($self, $method_name) = @_;
37 return $self->{methods}{$method_name};
38}
39
40sub has_method {
41 # my($self, $method_name) = @_;
823419c5 42 return 0; # to fool apply_methods() in combine()
71e7b544 43}
44
823419c5 45sub has_attribute {
71e7b544 46 # my($self, $method_name) = @_;
823419c5 47 return 0; # to fool appply_attributes() in combine()
71e7b544 48}
49
823419c5 50sub has_override_method_modifier {
71e7b544 51 # my($self, $method_name) = @_;
823419c5 52 return 0; # to fool apply_modifiers() in combine()
71e7b544 53}
54
823419c5 55sub 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 69sub 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 82sub 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
90package Mouse::Meta::Role::Application::RoleSummation;
91our @ISA = qw(Mouse::Meta::Role::Application);
71e7b544 92
823419c5 93sub 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
130package Mouse::Meta::Role::Composite;
71e7b544 1311;
132__END__
133
a25ca8d6 134=head1 NAME
135
136Mouse::Meta::Role::Composite - An object to represent the set of roles
137
138=head1 VERSION
139
43c1bb1a 140This document describes Mouse version 0.71
a25ca8d6 141
142=head1 SEE ALSO
143
144L<Moose::Meta::Role::Composite>
145
146=cut