Split accessor generators into Accessor.pm and Delegation.pm
[gitmo/Mouse.git] / lib / Mouse / Meta / Role / Composite.pm
1 package Mouse::Meta::Role::Composite;
2 use Mouse::Util qw(english_list); # enables strict and warnings
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
19     if($method_name ne 'meta'){
20         my $roles = $self->{composed_roles_by_method}{$method_name} ||= [];
21         push @{$roles}, $role;
22         if(@{$roles} > 1){
23             $self->{conflicting_methods}{$method_name}++;
24         }
25     }
26
27     $self->{methods}{$method_name} = $code;
28     # no need to add a subroutine to the stash
29     return;
30 }
31
32 sub get_method_body {
33     my($self, $method_name) = @_;
34     return $self->{methods}{$method_name};
35 }
36
37 sub has_method {
38     # my($self, $method_name) = @_;
39     return 0; # to fool _apply_methods() in combine()
40 }
41
42 sub has_attribute{
43     # my($self, $method_name) = @_;
44     return 0; # to fool _appply_attributes() in combine()
45 }
46
47 sub has_override_method_modifier{
48     # my($self, $method_name) = @_;
49     return 0; # to fool _apply_modifiers() in combine()
50 }
51
52 sub add_attribute{
53     my($self, $attr_name, $spec) = @_;
54
55     my $existing = $self->{attributes}{$attr_name};
56     if($existing && $existing != $spec){
57         $self->throw_error("We have encountered an attribute conflict with '$attr_name' "
58                          . "during composition. This is fatal error and cannot be disambiguated.");
59     }
60     $self->SUPER::add_attribute($attr_name, $spec);
61     return;
62 }
63
64 sub add_override_method_modifier{
65     my($self, $method_name, $code) = @_;
66
67     my $existing = $self->{override_method_modifiers}{$method_name};
68     if($existing && $existing != $code){
69         $self->throw_error( "We have encountered an 'override' method conflict with '$method_name' during "
70                           . "composition (Two 'override' methods of the same name encountered). "
71                           . "This is fatal error.")
72     }
73     $self->SUPER::add_override_method_modifier($method_name, $code);
74     return;
75 }
76
77 # components of apply()
78
79 sub _apply_methods{
80     my($self, $applicant, $args) = @_;
81
82     if(exists $self->{conflicting_methods}){
83         my $applicant_class_name = $applicant->name;
84
85         my @conflicting = sort grep{ !$applicant_class_name->can($_) } keys %{ $self->{conflicting_methods} };
86
87         if(@conflicting == 1){
88             my $method_name = $conflicting[0];
89             my @roles       = sort @{ $self->{composed_roles_by_method}{$method_name} };
90             $self->throw_error(
91                sprintf q{Due to a method name conflict in roles %s, the method '%s' must be implemented or excluded by '%s'},
92                    english_list(map{ sprintf q{'%s'}, $_->name } @roles), $method_name, $applicant->name
93             );
94         }
95         elsif(@conflicting > 1){
96             my $methods = english_list(map{ sprintf q{'%s'}, $_ } @conflicting);
97
98             my %seen;
99             my $roles   = english_list(
100                 sort map{ my $name = $_->name; $seen{$name}++ ? () : sprintf q{'%s'}, $name }
101                 map{ @{$_} } @{ $self->{composed_roles_by_method} }{@conflicting}
102             );
103
104             $self->throw_error(
105                sprintf q{Due to method name conflicts in roles %s, the methods %s must be implemented or excluded by '%s'},
106                    $roles, $methods, $applicant->name
107             );
108         }
109     }
110
111     $self->SUPER::_apply_methods($applicant, $args);
112     return;
113 }
114 1;
115 __END__
116
117 =head1 NAME
118
119 Mouse::Meta::Role::Composite - An object to represent the set of roles
120
121 =head1 VERSION
122
123 This document describes Mouse version 0.40_01
124
125 =head1 SEE ALSO
126
127 L<Moose::Meta::Role::Composite>
128
129 =cut