1 package Mouse::Meta::Role::Composite;
2 use Mouse::Util; # enables strict and warnings
4 use Mouse::Meta::Role::Application;
5 our @ISA = qw(Mouse::Meta::Role);
7 # FIXME: Mouse::Meta::Role::Composite does things in different way from Moose's
8 # Moose: creates a new class for the consumer, and applies roles to it.
9 # Mouse: creates a coposite role and apply roles to the role,
10 # and then applies it to the consumer.
14 my $args = $class->Mouse::Object::BUILDARGS(@_);
15 my $roles = delete $args->{roles};
16 my $self = $class->create_anon_role(%{$args});
17 foreach my $role_spec(@{$roles}) {
18 my($role, $args) = ref($role_spec) eq 'ARRAY'
21 $role->apply($self, %{$args});
28 return keys %{ $self->{methods} };
32 my($self, $method_name, $code, $role) = @_;
34 if( ($self->{methods}{$method_name} || 0) == $code){
35 # This role already has the same method.
39 if($method_name eq 'meta'){
40 $self->SUPER::add_method($method_name => $code);
43 # no need to add a subroutine to the stash
44 my $roles = $self->{composed_roles_by_method}{$method_name} ||= [];
45 push @{$roles}, $role;
47 $self->{conflicting_methods}{$method_name}++;
49 $self->{methods}{$method_name} = $code;
55 my($self, $method_name) = @_;
56 return $self->{methods}{$method_name};
60 # my($self, $method_name) = @_;
61 return 0; # to fool apply_methods() in combine()
65 # my($self, $method_name) = @_;
66 return 0; # to fool appply_attributes() in combine()
69 sub has_override_method_modifier {
70 # my($self, $method_name) = @_;
71 return 0; # to fool apply_modifiers() in combine()
76 my $attr_name = shift;
77 my $spec = (@_ == 1 ? $_[0] : {@_});
79 my $existing = $self->{attributes}{$attr_name};
80 if($existing && $existing != $spec){
81 $self->throw_error("We have encountered an attribute conflict with '$attr_name' "
82 . "during composition. This is fatal error and cannot be disambiguated.");
84 $self->SUPER::add_attribute($attr_name, $spec);
88 sub add_override_method_modifier {
89 my($self, $method_name, $code) = @_;
91 my $existing = $self->{override_method_modifiers}{$method_name};
92 if($existing && $existing != $code){
93 $self->throw_error( "We have encountered an 'override' method conflict with '$method_name' during "
94 . "composition (Two 'override' methods of the same name encountered). "
95 . "This is fatal error.")
97 $self->SUPER::add_override_method_modifier($method_name, $code);
103 my $consumer = shift;
105 Mouse::Meta::Role::Application::RoleSummation->new(@_)->apply($self, $consumer);
109 package Mouse::Meta::Role::Application::RoleSummation;
110 our @ISA = qw(Mouse::Meta::Role::Application);
113 my($self, $role, $consumer, @extra) = @_;
115 if(exists $role->{conflicting_methods}){
116 my $consumer_class_name = $consumer->name;
118 my @conflicting = grep{ !$consumer_class_name->can($_) }
119 keys %{ $role->{conflicting_methods} };
122 my $method_name_conflict = (@conflicting == 1
123 ? 'a method name conflict'
124 : 'method name conflicts');
127 my $roles = Mouse::Util::quoted_english_list(
128 grep{ !$seen{$_}++ } # uniq
131 @{ $role->{composed_roles_by_method} }{@conflicting}
134 $self->throw_error(sprintf
135 q{Due to %s in roles %s,}
136 . q{ the method%s %s must be implemented or excluded by '%s'},
137 $method_name_conflict,
139 (@conflicting > 1 ? 's' : ''),
140 Mouse::Util::quoted_english_list(@conflicting),
141 $consumer_class_name);
145 $self->SUPER::apply_methods($role, $consumer, @extra);
149 package Mouse::Meta::Role::Composite;
155 Mouse::Meta::Role::Composite - An object to represent the set of roles
159 This document describes Mouse version 0.80
163 L<Moose::Meta::Role::Composite>