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 | } |
7a50b450 |
23 | |
9009aca1 |
24 | return $self; |
7a50b450 |
25 | } |
26 | |
27 | sub create_anon_role{ |
28 | my $self = shift; |
29 | return $self->create(undef, @_); |
30 | } |
31 | |
43165725 |
32 | sub is_anon_role; |
a2227e71 |
33 | |
43165725 |
34 | sub get_roles; |
afc73948 |
35 | |
e7264861 |
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 | |
6cfa1e5e |
43 | sub get_required_method_list{ |
44 | return @{ $_[0]->{required_methods} }; |
45 | } |
afc73948 |
46 | |
59089ec3 |
47 | sub add_required_methods { |
ea249879 |
48 | my($self, @methods) = @_; |
71e7b544 |
49 | my %required = map{ $_ => 1 } @{$self->{required_methods}}; |
50 | push @{$self->{required_methods}}, grep{ !$required{$_}++ && !$self->has_method($_) } @methods; |
51 | return; |
59089ec3 |
52 | } |
53 | |
6cfa1e5e |
54 | sub requires_method { |
55 | my($self, $name) = @_; |
56 | return scalar( grep{ $_ eq $name } @{ $self->{required_methods} } ) != 0; |
57 | } |
58 | |
274b6cce |
59 | sub add_attribute { |
60 | my $self = shift; |
61 | my $name = shift; |
6cfa1e5e |
62 | |
63 | $self->{attributes}->{$name} = (@_ == 1) ? $_[0] : { @_ }; |
c9313657 |
64 | return; |
da0c885d |
65 | } |
66 | |
21498b08 |
67 | |
3a63a2e7 |
68 | # Moose uses Application::ToInstance, Application::ToClass, Application::ToRole |
69 | sub apply { |
45f22b92 |
70 | my $self = shift; |
71 | my $consumer = shift; |
7a50b450 |
72 | |
823419c5 |
73 | require 'Mouse/Meta/Role/Application.pm'; |
74 | return Mouse::Meta::Role::Application->new(@_)->apply($self, $consumer); |
71e7b544 |
75 | } |
76 | |
21498b08 |
77 | |
71e7b544 |
78 | sub combine { |
230dd14a |
79 | my($self, @role_specs) = @_; |
21498b08 |
80 | |
823419c5 |
81 | require 'Mouse/Meta/Role/Composite.pm'; |
71e7b544 |
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}); |
21498b08 |
87 | } |
71e7b544 |
88 | return $composite; |
21498b08 |
89 | } |
90 | |
cb60d0b5 |
91 | sub add_before_method_modifier; |
92 | sub add_around_method_modifier; |
93 | sub add_after_method_modifier; |
3a63a2e7 |
94 | |
cb60d0b5 |
95 | sub get_before_method_modifiers; |
96 | sub get_around_method_modifiers; |
97 | sub get_after_method_modifiers; |
47f36c05 |
98 | |
6cfa1e5e |
99 | sub add_override_method_modifier{ |
100 | my($self, $method_name, $method) = @_; |
101 | |
60b5c3be |
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) |
8e64d0fa |
105 | $self->throw_error("Cannot add an override of method '$method_name' " |
60b5c3be |
106 | . "because there is a local version of '$method_name'" |
107 | . "(A local method of the same name as been found)"); |
108 | } |
6cfa1e5e |
109 | |
110 | $self->{override_method_modifiers}->{$method_name} = $method; |
111 | } |
112 | |
8e64d0fa |
113 | sub get_override_method_modifier { |
114 | my ($self, $method_name) = @_; |
115 | return $self->{override_method_modifiers}->{$method_name}; |
6cfa1e5e |
116 | } |
117 | |
67199842 |
118 | sub does_role { |
119 | my ($self, $role_name) = @_; |
120 | |
121 | (defined $role_name) |
fce211ae |
122 | || $self->throw_error("You must supply a role name to look for"); |
67199842 |
123 | |
f3e11122 |
124 | $role_name = $role_name->name if ref $role_name; |
125 | |
67199842 |
126 | # if we are it,.. then return true |
127 | return 1 if $role_name eq $self->name; |
3a63a2e7 |
128 | # otherwise.. check our children |
129 | for my $role (@{ $self->get_roles }) { |
67199842 |
130 | return 1 if $role->does_role($role_name); |
131 | } |
132 | return 0; |
133 | } |
134 | |
a2227e71 |
135 | 1; |
1820fffe |
136 | __END__ |
137 | |
138 | =head1 NAME |
139 | |
140 | Mouse::Meta::Role - The Mouse Role metaclass |
141 | |
a25ca8d6 |
142 | =head1 VERSION |
143 | |
86eb0b5e |
144 | This document describes Mouse version 0.70 |
a25ca8d6 |
145 | |
503ed648 |
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 | |
1820fffe |
151 | =head1 SEE ALSO |
152 | |
153 | L<Moose::Meta::Role> |
154 | |
155 | =cut |