lib/Mouse/Meta/Role/Composite.pm

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