lib/Mouse/Meta/Role.pm

   1 package Mouse::Meta::Role;
   2 use Mouse::Util qw(:meta); # enables strict and warnings
   3
   4 use Mouse::Meta::Module;
   5 our @ISA = qw(Mouse::Meta::Module);
   6
   7 sub method_metaclass;
   8
   9 sub _construct_meta {
  10     my $class = shift;
  11
  12     my %args  = @_;
  13
  14     $args{methods}          = {};
  15     $args{attributes}       = {};
  16     $args{required_methods} = [];
  17     $args{roles}            = [];
  18
  19     my $self = bless \%args, ref($class) || $class;
  20     if($class ne __PACKAGE__){
  21         $self->meta->_initialize_object($self, \%args);
  22     }
  23
  24     return $self;
  25 }
  26
  27 sub create_anon_role{
  28     my $self = shift;
  29     return $self->create(undef, @_);
  30 }
  31
  32 sub is_anon_role;
  33
  34 sub get_roles;
  35
  36 sub calculate_all_roles {
  37     my $self = shift;
  38     my %seen;
  39     return grep { !$seen{ $_->name }++ }
  40            ($self, map  { $_->calculate_all_roles } @{ $self->get_roles });
  41 }
  42
  43 sub get_required_method_list{
  44     return @{ $_[0]->{required_methods} };
  45 }
  46
  47 sub add_required_methods {
  48     my($self, @methods) = @_;
  49     my %required = map{ $_ => 1 } @{$self->{required_methods}};
  50     push @{$self->{required_methods}}, grep{ !$required{$_}++ && !$self->has_method($_) } @methods;
  51     return;
  52 }
  53
  54 sub requires_method {
  55     my($self, $name) = @_;
  56     return scalar( grep{ $_ eq $name } @{ $self->{required_methods} } ) != 0;
  57 }
  58
  59 sub add_attribute {
  60     my $self = shift;
  61     my $name = shift;
  62
  63     $self->{attributes}->{$name} = (@_ == 1) ? $_[0] : { @_ };
  64     return;
  65 }
  66
  67
  68 # Moose uses Application::ToInstance, Application::ToClass, Application::ToRole
  69 sub apply {
  70     my $self     = shift;
  71     my $consumer = shift;
  72
  73     require 'Mouse/Meta/Role/Application.pm';
  74     return Mouse::Meta::Role::Application->new(@_)->apply($self, $consumer);
  75 }
  76
  77
  78 sub combine {
  79     my($self, @role_specs) = @_;
  80
  81     require 'Mouse/Meta/Role/Composite.pm';
  82     my $composite = Mouse::Meta::Role::Composite->create_anon_role();
  83
  84     foreach my $role_spec (@role_specs) {
  85         my($role_name, $args) = @{$role_spec};
  86         $role_name->meta->apply($composite, %{$args});
  87     }
  88     return $composite;
  89 }
  90
  91 sub add_before_method_modifier;
  92 sub add_around_method_modifier;
  93 sub add_after_method_modifier;
  94
  95 sub get_before_method_modifiers;
  96 sub get_around_method_modifiers;
  97 sub get_after_method_modifiers;
  98
  99 sub add_override_method_modifier{
 100     my($self, $method_name, $method) = @_;
 101
 102     if($self->has_method($method_name)){
 103         # This error happens in the override keyword or during role composition,
 104         # so I added a message, "A local method of ...", only for compatibility (gfx)
 105         $self->throw_error("Cannot add an override of method '$method_name' "
 106                    . "because there is a local version of '$method_name'"
 107                    . "(A local method of the same name as been found)");
 108     }
 109
 110     $self->{override_method_modifiers}->{$method_name} = $method;
 111 }
 112
 113 sub get_override_method_modifier {
 114     my ($self, $method_name) = @_;
 115     return $self->{override_method_modifiers}->{$method_name};
 116 }
 117
 118 sub does_role {
 119     my ($self, $role_name) = @_;
 120
 121     (defined $role_name)
 122         || $self->throw_error("You must supply a role name to look for");
 123
 124     $role_name = $role_name->name if ref $role_name;
 125
 126     # if we are it,.. then return true
 127     return 1 if $role_name eq $self->name;
 128     # otherwise.. check our children
 129     for my $role (@{ $self->get_roles }) {
 130         return 1 if $role->does_role($role_name);
 131     }
 132     return 0;
 133 }
 134
 135 1;
 136 __END__
 137
 138 =head1 NAME
 139
 140 Mouse::Meta::Role - The Mouse Role metaclass
 141
 142 =head1 VERSION
 143
 144 This document describes Mouse version 0.70
 145
 146 =head1 DESCRIPTION
 147
 148 This class is a meta object protocol for Mouse roles,
 149 which is a subset of Moose::Meta:::Role.
 150
 151 =head1 SEE ALSO
 152
 153 L<Moose::Meta::Role>
 154
 155 =cut