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($options{role_name});
37 my $self = $class->meta->new_object(%options);
42 my ($self, $other) = @_;
44 foreach my $attribute_name ($self->get_attribute_list) {
45 # skip it if it has one already
46 next if $other->has_attribute($attribute_name);
47 # add it, although it could be overriden
48 $other->add_attribute(
50 %{$self->get_attribute($attribute_name)}
54 foreach my $method_name ($self->get_method_list) {
55 # skip it if it has one already
56 next if $other->has_method($method_name);
57 # add it, although it could be overriden
60 $self->get_method($method_name)
64 foreach my $method_name ($self->get_method_modifier_list('override')) {
65 # skip it if it has one already
66 next if $other->has_method($method_name);
67 # add it, although it could be overriden
68 $other->add_override_method_modifier(
70 $self->get_method_modifier('override' => $method_name),
75 foreach my $method_name ($self->get_method_modifier_list('before')) {
76 $other->add_before_method_modifier(
78 $self->get_method_modifier('before' => $method_name)
82 foreach my $method_name ($self->get_method_modifier_list('after')) {
83 $other->add_after_method_modifier(
85 $self->get_method_modifier('after' => $method_name)
89 foreach my $method_name ($self->get_method_modifier_list('around')) {
90 $other->add_around_method_modifier(
92 $self->get_method_modifier('around' => $method_name)
99 # we delegate to some role_meta methods for convience here
100 # the Moose::Meta::Role is meant to be a read-only interface
101 # to the underlying role package, if you want to manipulate
102 # that, just use ->role_meta
104 sub name { (shift)->role_meta->name }
105 sub version { (shift)->role_meta->version }
107 sub get_method { (shift)->role_meta->get_method(@_) }
108 sub has_method { (shift)->role_meta->has_method(@_) }
109 sub get_method_list {
111 # meta is not applicable in this context,
112 # if you want to see it use the ->role_meta
113 grep { !/^meta$/ } $self->role_meta->get_method_list;
116 # ... however the items in statis (attributes & method modifiers)
117 # can be removed and added to through this API
122 my ($self, $name, %attr_desc) = @_;
123 $self->get_attribute_map->{$name} = \%attr_desc;
127 my ($self, $name) = @_;
128 exists $self->get_attribute_map->{$name} ? 1 : 0;
132 my ($self, $name) = @_;
133 $self->get_attribute_map->{$name}
136 sub remove_attribute {
137 my ($self, $name) = @_;
138 delete $self->get_attribute_map->{$name}
141 sub get_attribute_list {
143 keys %{$self->get_attribute_map};
148 sub add_method_modifier {
149 my ($self, $modifier_type, $method_name, $method) = @_;
150 $self->get_method_modifier_map->{$modifier_type}->{$method_name} = $method;
153 sub has_method_modifier {
154 my ($self, $modifier_type, $method_name) = @_;
155 exists $self->get_method_modifier_map->{$modifier_type}->{$method_name} ? 1 : 0
158 sub get_method_modifier {
159 my ($self, $modifier_type, $method_name) = @_;
160 $self->get_method_modifier_map->{$modifier_type}->{$method_name};
163 sub remove_method_modifier {
164 my ($self, $modifier_type, $method_name) = @_;
165 delete $self->get_method_modifier_map->{$modifier_type}->{$method_name};
168 sub get_method_modifier_list {
169 my ($self, $modifier_type) = @_;
170 keys %{$self->get_method_modifier_map->{$modifier_type}};
182 Moose::Meta::Role - The Moose Role metaclass
214 =item B<get_method_list>
220 =item B<add_attribute>
222 =item B<has_attribute>
224 =item B<get_attribute>
226 =item B<get_attribute_list>
228 =item B<get_attribute_map>
230 =item B<remove_attribute>
236 =item B<add_method_modifier>
238 =item B<get_method_modifier>
240 =item B<has_method_modifier>
242 =item B<get_method_modifier_list>
244 =item B<get_method_modifier_map>
246 =item B<remove_method_modifier>
252 All complex software has bugs lurking in it, and this module is no
253 exception. If you find a bug please either email me, or add the bug
258 Stevan Little E<lt>stevan@iinteractive.comE<gt>
260 =head1 COPYRIGHT AND LICENSE
262 Copyright 2006 by Infinity Interactive, Inc.
264 L<http://www.iinteractive.com>
266 This library is free software; you can redistribute it and/or modify
267 it under the same terms as Perl itself.