2 package Moose::Meta::Role;
10 our $VERSION = '0.01';
12 __PACKAGE__->meta->add_attribute('role_meta' => (
16 __PACKAGE__->meta->add_attribute('attribute_map' => (
17 reader => 'get_attribute_map',
21 __PACKAGE__->meta->add_attribute('method_modifier_map' => (
22 reader => 'get_method_modifier_map',
36 $options{role_meta} = Class::MOP::Class->initialize(
38 ':method_metaclass' => 'Moose::Meta::Role::Method'
40 my $self = $class->meta->new_object(%options);
45 my ($self, $other) = @_;
47 foreach my $attribute_name ($self->get_attribute_list) {
48 # skip it if it has one already
49 next if $other->has_attribute($attribute_name);
50 # add it, although it could be overriden
51 $other->add_attribute(
53 %{$self->get_attribute($attribute_name)}
57 foreach my $method_name ($self->get_method_list) {
58 # skip it if it has one already
59 next if $other->has_method($method_name);
60 # add it, although it could be overriden
63 $self->get_method($method_name)
67 foreach my $method_name ($self->get_method_modifier_list('override')) {
68 # skip it if it has one already
69 next if $other->has_method($method_name);
70 # add it, although it could be overriden
71 $other->add_override_method_modifier(
73 $self->get_method_modifier('override' => $method_name),
78 foreach my $method_name ($self->get_method_modifier_list('before')) {
79 $other->add_before_method_modifier(
81 $self->get_method_modifier('before' => $method_name)
85 foreach my $method_name ($self->get_method_modifier_list('after')) {
86 $other->add_after_method_modifier(
88 $self->get_method_modifier('after' => $method_name)
92 foreach my $method_name ($self->get_method_modifier_list('around')) {
93 $other->add_around_method_modifier(
95 $self->get_method_modifier('around' => $method_name)
102 # we delegate to some role_meta methods for convience here
103 # the Moose::Meta::Role is meant to be a read-only interface
104 # to the underlying role package, if you want to manipulate
105 # that, just use ->role_meta
107 sub name { (shift)->role_meta->name }
108 sub version { (shift)->role_meta->version }
110 sub get_method { (shift)->role_meta->get_method(@_) }
111 sub has_method { (shift)->role_meta->has_method(@_) }
112 sub get_method_list {
114 # meta is not applicable in this context,
115 # if you want to see it use the ->role_meta
116 grep { !/^meta$/ } $self->role_meta->get_method_list;
119 # ... however the items in statis (attributes & method modifiers)
120 # can be removed and added to through this API
125 my ($self, $name, %attr_desc) = @_;
126 $self->get_attribute_map->{$name} = \%attr_desc;
130 my ($self, $name) = @_;
131 exists $self->get_attribute_map->{$name} ? 1 : 0;
135 my ($self, $name) = @_;
136 $self->get_attribute_map->{$name}
139 sub remove_attribute {
140 my ($self, $name) = @_;
141 delete $self->get_attribute_map->{$name}
144 sub get_attribute_list {
146 keys %{$self->get_attribute_map};
151 sub add_method_modifier {
152 my ($self, $modifier_type, $method_name, $method) = @_;
153 $self->get_method_modifier_map->{$modifier_type}->{$method_name} = $method;
156 sub has_method_modifier {
157 my ($self, $modifier_type, $method_name) = @_;
158 exists $self->get_method_modifier_map->{$modifier_type}->{$method_name} ? 1 : 0
161 sub get_method_modifier {
162 my ($self, $modifier_type, $method_name) = @_;
163 $self->get_method_modifier_map->{$modifier_type}->{$method_name};
166 sub remove_method_modifier {
167 my ($self, $modifier_type, $method_name) = @_;
168 delete $self->get_method_modifier_map->{$modifier_type}->{$method_name};
171 sub get_method_modifier_list {
172 my ($self, $modifier_type) = @_;
173 keys %{$self->get_method_modifier_map->{$modifier_type}};
176 package Moose::Meta::Role::Method;
181 our $VERSION = '0.01';
183 use base 'Class::MOP::Method';
193 Moose::Meta::Role - The Moose Role metaclass
225 =item B<get_method_list>
231 =item B<add_attribute>
233 =item B<has_attribute>
235 =item B<get_attribute>
237 =item B<get_attribute_list>
239 =item B<get_attribute_map>
241 =item B<remove_attribute>
247 =item B<add_method_modifier>
249 =item B<get_method_modifier>
251 =item B<has_method_modifier>
253 =item B<get_method_modifier_list>
255 =item B<get_method_modifier_map>
257 =item B<remove_method_modifier>
263 All complex software has bugs lurking in it, and this module is no
264 exception. If you find a bug please either email me, or add the bug
269 Stevan Little E<lt>stevan@iinteractive.comE<gt>
271 =head1 COPYRIGHT AND LICENSE
273 Copyright 2006 by Infinity Interactive, Inc.
275 L<http://www.iinteractive.com>
277 This library is free software; you can redistribute it and/or modify
278 it under the same terms as Perl itself.