Commit | Line | Data |
a2227e71 |
1 | package Mouse::Meta::Role; |
4cc4f8ed |
2 | use Mouse::Util qw(:meta); # enables strict and warnings |
74be9f76 |
3 | |
6d28c5cf |
4 | use Mouse::Meta::Module; |
f3bb863f |
5 | our @ISA = qw(Mouse::Meta::Module); |
a2227e71 |
6 | |
e058b279 |
7 | sub method_metaclass; |
6cfa1e5e |
8 | |
8e64d0fa |
9 | sub _construct_meta { |
acf0f643 |
10 | my $class = shift; |
7a50b450 |
11 | |
acf0f643 |
12 | my %args = @_; |
13 | |
5132ec42 |
14 | $args{methods} = {}; |
15 | $args{attributes} = {}; |
16 | $args{required_methods} = []; |
17 | $args{roles} = []; |
274b6cce |
18 | |
9009aca1 |
19 | my $self = bless \%args, ref($class) || $class; |
20 | if($class ne __PACKAGE__){ |
21 | $self->meta->_initialize_object($self, \%args); |
22 | } |
9009aca1 |
23 | return $self; |
7a50b450 |
24 | } |
25 | |
26 | sub create_anon_role{ |
27 | my $self = shift; |
28 | return $self->create(undef, @_); |
29 | } |
30 | |
43165725 |
31 | sub is_anon_role; |
a2227e71 |
32 | |
43165725 |
33 | sub get_roles; |
afc73948 |
34 | |
e7264861 |
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 | |
6cfa1e5e |
42 | sub get_required_method_list{ |
43 | return @{ $_[0]->{required_methods} }; |
44 | } |
afc73948 |
45 | |
59089ec3 |
46 | sub add_required_methods { |
ea249879 |
47 | my($self, @methods) = @_; |
71e7b544 |
48 | my %required = map{ $_ => 1 } @{$self->{required_methods}}; |
49 | push @{$self->{required_methods}}, grep{ !$required{$_}++ && !$self->has_method($_) } @methods; |
50 | return; |
59089ec3 |
51 | } |
52 | |
6cfa1e5e |
53 | sub requires_method { |
54 | my($self, $name) = @_; |
55 | return scalar( grep{ $_ eq $name } @{ $self->{required_methods} } ) != 0; |
56 | } |
57 | |
274b6cce |
58 | sub add_attribute { |
59 | my $self = shift; |
60 | my $name = shift; |
6cfa1e5e |
61 | |
62 | $self->{attributes}->{$name} = (@_ == 1) ? $_[0] : { @_ }; |
c9313657 |
63 | return; |
da0c885d |
64 | } |
65 | |
3a63a2e7 |
66 | sub apply { |
45f22b92 |
67 | my $self = shift; |
68 | my $consumer = shift; |
7a50b450 |
69 | |
823419c5 |
70 | require 'Mouse/Meta/Role/Application.pm'; |
71 | return Mouse::Meta::Role::Application->new(@_)->apply($self, $consumer); |
71e7b544 |
72 | } |
73 | |
71e7b544 |
74 | sub combine { |
230dd14a |
75 | my($self, @role_specs) = @_; |
21498b08 |
76 | |
823419c5 |
77 | require 'Mouse/Meta/Role/Composite.pm'; |
92d87891 |
78 | return Mouse::Meta::Role::Composite->new(roles => \@role_specs); |
21498b08 |
79 | } |
80 | |
cb60d0b5 |
81 | sub add_before_method_modifier; |
82 | sub add_around_method_modifier; |
83 | sub add_after_method_modifier; |
3a63a2e7 |
84 | |
cb60d0b5 |
85 | sub get_before_method_modifiers; |
86 | sub get_around_method_modifiers; |
87 | sub get_after_method_modifiers; |
47f36c05 |
88 | |
6cfa1e5e |
89 | sub add_override_method_modifier{ |
90 | my($self, $method_name, $method) = @_; |
91 | |
60b5c3be |
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) |
8e64d0fa |
95 | $self->throw_error("Cannot add an override of method '$method_name' " |
60b5c3be |
96 | . "because there is a local version of '$method_name'" |
97 | . "(A local method of the same name as been found)"); |
98 | } |
6cfa1e5e |
99 | |
100 | $self->{override_method_modifiers}->{$method_name} = $method; |
101 | } |
102 | |
8e64d0fa |
103 | sub get_override_method_modifier { |
104 | my ($self, $method_name) = @_; |
105 | return $self->{override_method_modifiers}->{$method_name}; |
6cfa1e5e |
106 | } |
107 | |
67199842 |
108 | sub does_role { |
109 | my ($self, $role_name) = @_; |
110 | |
111 | (defined $role_name) |
fce211ae |
112 | || $self->throw_error("You must supply a role name to look for"); |
67199842 |
113 | |
f3e11122 |
114 | $role_name = $role_name->name if ref $role_name; |
115 | |
67199842 |
116 | # if we are it,.. then return true |
117 | return 1 if $role_name eq $self->name; |
3a63a2e7 |
118 | # otherwise.. check our children |
119 | for my $role (@{ $self->get_roles }) { |
67199842 |
120 | return 1 if $role->does_role($role_name); |
121 | } |
122 | return 0; |
123 | } |
124 | |
a2227e71 |
125 | 1; |
1820fffe |
126 | __END__ |
127 | |
128 | =head1 NAME |
129 | |
130 | Mouse::Meta::Role - The Mouse Role metaclass |
131 | |
a25ca8d6 |
132 | =head1 VERSION |
133 | |
999072ab |
134 | This document describes Mouse version 0.82 |
a25ca8d6 |
135 | |
503ed648 |
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 | |
1820fffe |
141 | =head1 SEE ALSO |
142 | |
143 | L<Moose::Meta::Role> |
144 | |
145 | =cut |