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