1 package Mouse::Meta::Role::Application;
2 use Mouse::Util qw(:meta);
6 my $args = $class->Mouse::Object::BUILDARGS(@_);
8 if(exists $args->{exclude} or exists $args->{alias}) {
9 warnings::warnif(deprecated =>
10 'The alias and excludes options for role application have been'
11 . ' renamed -alias and -exclude');
13 if($args->{alias} && !exists $args->{-alias}){
14 $args->{-alias} = $args->{alias};
16 if($args->{excludes} && !exists $args->{-excludes}){
17 $args->{-excludes} = $args->{excludes};
21 $args->{aliased_methods} = {};
22 if(my $alias = $args->{-alias}){
23 @{$args->{aliased_methods}}{ values %{$alias} } = ();
26 if(my $excludes = $args->{-excludes}){
27 $args->{-excludes} = {}; # replace with a hash ref
29 %{$args->{-excludes}} = (map{ $_ => undef } @{$excludes});
32 $args->{-excludes}{$excludes} = undef;
35 my $self = bless $args, $class;
36 if($class ne __PACKAGE__){
37 $self->meta->_initialize_object($self, $args);
43 my($self, $role, $consumer, @extra) = @_;
46 if(Mouse::Util::is_a_metaclass($consumer)) { # Application::ToClass
47 $self->{_to} = 'class';
49 elsif(Mouse::Util::is_a_metarole($consumer)) { # Application::ToRole
50 $self->{_to} = 'role';
52 else { # Appplication::ToInstance
53 $self->{_to} = 'instance';
54 $instance = $consumer;
56 $consumer = (Mouse::Util::class_of($instance) || 'Mouse::Meta::Class')
58 superclasses => [ref $instance],
63 #$self->check_role_exclusions($role, $consumer, @extra);
64 $self->check_required_methods($role, $consumer, @extra);
65 #$self->check_required_attributes($role, $consumer, @extra);
67 $self->apply_attributes($role, $consumer, @extra);
68 $self->apply_methods($role, $consumer, @extra);
69 #$self->apply_override_method_modifiers($role, $consumer, @extra);
70 #$self->apply_before_method_modifiers($role, $consumer, @extra);
71 #$self->apply_around_method_modifiers($role, $consumer, @extra);
72 #$self->apply_after_method_modifiers($role, $consumer, @extra);
73 $self->apply_modifiers($role, $consumer, @extra);
75 $self->_append_roles($role, $consumer);
77 if(defined $instance){ # Application::ToInstance
79 bless $instance, $consumer->name;
80 $consumer->_initialize_object($instance, $instance, 1);
86 sub check_required_methods {
87 my($self, $role, $consumer) = @_;
89 if($self->{_to} eq 'role'){
90 $consumer->add_required_methods($role->get_required_method_list);
92 else{ # to class or instance
93 my $consumer_class_name = $consumer->name;
96 foreach my $method_name(@{$role->{required_methods}}){
97 next if exists $self->{aliased_methods}{$method_name};
98 next if exists $role->{methods}{$method_name};
99 next if $consumer_class_name->can($method_name);
101 push @missing, $method_name;
104 $role->throw_error(sprintf "'%s' requires the method%s %s to be implemented by '%s'",
106 (@missing == 1 ? '' : 's'), # method or methods
107 Mouse::Util::quoted_english_list(@missing),
108 $consumer_class_name);
116 my($self, $role, $consumer) = @_;
118 my $alias = $self->{-alias};
119 my $excludes = $self->{-excludes};
121 foreach my $method_name($role->get_method_list){
122 next if $method_name eq 'meta';
124 my $code = $role->get_method_body($method_name);
126 if(!exists $excludes->{$method_name}){
127 if(!$consumer->has_method($method_name)){
128 # The third argument $role is used in Role::Composite
129 $consumer->add_method($method_name => $code, $role);
133 if(exists $alias->{$method_name}){
134 my $dstname = $alias->{$method_name};
136 my $dstcode = $consumer->get_method_body($dstname);
138 if(defined($dstcode) && $dstcode != $code){
139 $role->throw_error("Cannot create a method alias if a local method of the same name exists");
142 $consumer->add_method($dstname => $code, $role);
150 sub apply_attributes {
151 my($self, $role, $consumer) = @_;
153 for my $attr_name ($role->get_attribute_list) {
154 next if $consumer->has_attribute($attr_name);
156 $consumer->add_attribute($attr_name
157 => $role->get_attribute($attr_name));
162 sub apply_modifiers {
163 my($self, $role, $consumer) = @_;
165 if(my $modifiers = $role->{override_method_modifiers}){
166 foreach my $method_name (keys %{$modifiers}){
167 $consumer->add_override_method_modifier(
168 $method_name => $modifiers->{$method_name});
172 for my $modifier_type (qw/before around after/) {
173 my $table = $role->{"${modifier_type}_method_modifiers"}
176 my $add_modifier = "add_${modifier_type}_method_modifier";
178 while(my($method_name, $modifiers) = each %{$table}){
179 foreach my $code(@{ $modifiers }) {
180 # skip if the modifier is already applied
181 next if $consumer->{"_applied_$modifier_type"}{$method_name, $code}++;
182 $consumer->$add_modifier($method_name => $code);
190 my($self, $role, $metaclass_or_role) = @_;
192 my $roles = $metaclass_or_role->{roles};
193 foreach my $r($role, @{$role->get_roles}){
194 if(!$metaclass_or_role->does_role($r)){
205 Mouse::Meta::Role::Application - The Mouse role application class
209 This document describes Mouse version 0.71
213 L<Moose::Role::Application>
215 L<Moose::Role::Application::ToClass>
217 L<Moose::Role::Application::ToRole>
219 L<Moose::Role::Application::ToInstance>