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],
62 in_application_to_instance => 1, # suppress to apply roles
66 #$self->check_role_exclusions($role, $consumer, @extra);
67 $self->check_required_methods($role, $consumer, @extra);
68 #$self->check_required_attributes($role, $consumer, @extra);
70 $self->apply_attributes($role, $consumer, @extra);
71 $self->apply_methods($role, $consumer, @extra);
72 #$self->apply_override_method_modifiers($role, $consumer, @extra);
73 #$self->apply_before_method_modifiers($role, $consumer, @extra);
74 #$self->apply_around_method_modifiers($role, $consumer, @extra);
75 #$self->apply_after_method_modifiers($role, $consumer, @extra);
76 $self->apply_modifiers($role, $consumer, @extra);
78 $self->_append_roles($role, $consumer);
80 if(defined $instance){ # Application::ToInstance
82 bless $instance, $consumer->name;
83 $consumer->_initialize_object($instance, $instance, 1);
89 sub check_required_methods {
90 my($self, $role, $consumer) = @_;
92 if($self->{_to} eq 'role'){
93 $consumer->add_required_methods($role->get_required_method_list);
95 else{ # to class or instance
96 my $consumer_class_name = $consumer->name;
99 foreach my $method_name(@{$role->{required_methods}}){
100 next if exists $self->{aliased_methods}{$method_name};
101 next if exists $role->{methods}{$method_name};
102 next if $consumer_class_name->can($method_name);
104 push @missing, $method_name;
107 $role->throw_error(sprintf "'%s' requires the method%s %s to be implemented by '%s'",
109 (@missing == 1 ? '' : 's'), # method or methods
110 Mouse::Util::quoted_english_list(@missing),
111 $consumer_class_name);
119 my($self, $role, $consumer) = @_;
121 my $alias = $self->{-alias};
122 my $excludes = $self->{-excludes};
124 foreach my $method_name($role->get_method_list){
125 next if $method_name eq 'meta';
127 my $code = $role->get_method_body($method_name);
129 if(!exists $excludes->{$method_name}){
130 if(!$consumer->has_method($method_name)){
131 # The third argument $role is used in Role::Composite
132 $consumer->add_method($method_name => $code, $role);
136 if(exists $alias->{$method_name}){
137 my $dstname = $alias->{$method_name};
139 my $dstcode = $consumer->get_method_body($dstname);
141 if(defined($dstcode) && $dstcode != $code){
142 $role->throw_error("Cannot create a method alias if a local method of the same name exists");
145 $consumer->add_method($dstname => $code, $role);
153 sub apply_attributes {
154 my($self, $role, $consumer) = @_;
156 for my $attr_name ($role->get_attribute_list) {
157 next if $consumer->has_attribute($attr_name);
159 $consumer->add_attribute($attr_name
160 => $role->get_attribute($attr_name));
165 sub apply_modifiers {
166 my($self, $role, $consumer) = @_;
168 if(my $modifiers = $role->{override_method_modifiers}){
169 foreach my $method_name (keys %{$modifiers}){
170 $consumer->add_override_method_modifier(
171 $method_name => $modifiers->{$method_name});
175 for my $modifier_type (qw/before around after/) {
176 my $table = $role->{"${modifier_type}_method_modifiers"}
179 my $add_modifier = "add_${modifier_type}_method_modifier";
181 while(my($method_name, $modifiers) = each %{$table}){
182 foreach my $code(@{ $modifiers }) {
183 # skip if the modifier is already applied
184 next if $consumer->{"_applied_$modifier_type"}{$method_name, $code}++;
185 $consumer->$add_modifier($method_name => $code);
193 my($self, $role, $metaclass_or_role) = @_;
195 my $roles = $metaclass_or_role->{roles};
196 foreach my $r($role, @{$role->get_roles}){
197 if(!$metaclass_or_role->does_role($r)){
208 Mouse::Meta::Role::Application - The Mouse role application class
212 This document describes Mouse version 0.90
216 L<Moose::Role::Application>
218 L<Moose::Role::Application::ToClass>
220 L<Moose::Role::Application::ToRole>
222 L<Moose::Role::Application::ToInstance>