2 package Moose::Meta::Class;
10 use Scalar::Util 'weaken', 'blessed', 'reftype';
12 our $VERSION = '0.06';
14 use base 'Class::MOP::Class';
16 __PACKAGE__->meta->add_attribute('roles' => (
24 $class->SUPER::initialize($pkg,
25 ':attribute_metaclass' => 'Moose::Meta::Attribute',
26 ':instance_metaclass' => 'Moose::Meta::Instance',
31 my ($self, $role) = @_;
32 (blessed($role) && $role->isa('Moose::Meta::Role'))
33 || confess "Roles must be instances of Moose::Meta::Role";
34 push @{$self->roles} => $role;
38 my ($self, $role_name) = @_;
40 || confess "You must supply a role name to look for";
41 foreach my $class ($self->class_precedence_list) {
42 foreach my $role (@{$class->meta->roles}) {
43 return 1 if $role->does_role($role_name);
50 my ($self, $role_name) = @_;
52 || confess "You must supply a role name to look for";
53 foreach my $class ($self->class_precedence_list) {
54 foreach my $role (@{$class->meta->roles}) {
55 return 1 if $role->excludes_role($role_name);
62 my ($class, %params) = @_;
63 my $self = $class->SUPER::new_object(%params);
64 foreach my $attr ($class->compute_all_applicable_attributes()) {
65 next unless $params{$attr->init_arg} && $attr->can('has_trigger') && $attr->has_trigger;
66 $attr->trigger->($self, $params{$attr->init_arg}, $attr);
71 sub construct_instance {
72 my ($class, %params) = @_;
73 my $meta_instance = $class->get_meta_instance;
75 # the code below is almost certainly incorrect
76 # but this is foreign inheritence, so we might
77 # have to kludge it in the end.
78 my $instance = $params{'__INSTANCE__'} || $meta_instance->create_instance();
79 foreach my $attr ($class->compute_all_applicable_attributes()) {
80 $attr->initialize_instance_slot($meta_instance, $instance, \%params)
86 my ($self, $method_name) = @_;
87 (defined $method_name && $method_name)
88 || confess "You must define a method name";
90 my $sub_name = ($self->name . '::' . $method_name);
93 return 0 if !defined(&{$sub_name});
94 my $method = \&{$sub_name};
96 return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method');
97 return $self->SUPER::has_method($method_name);
103 if (scalar @_ == 1 && ref($_[0]) eq 'HASH') {
105 # if it is a HASH ref, we de-ref it.
106 # this will usually mean that it is
108 $self->SUPER::add_attribute($name => %{$_[0]});
111 # otherwise we just pass the args
112 $self->SUPER::add_attribute($name => @_);
116 sub add_override_method_modifier {
117 my ($self, $name, $method, $_super_package) = @_;
118 (!$self->has_method($name))
119 || confess "Cannot add an override method if a local method is already present";
120 # need this for roles ...
121 $_super_package ||= $self->name;
122 my $super = $self->find_next_method_by_name($name);
124 || confess "You cannot override '$name' because it has no super method";
125 $self->add_method($name => bless sub {
128 no warnings 'redefine';
129 local *{$_super_package . '::super'} = sub { $super->(@args) };
130 return $method->(@args);
131 } => 'Moose::Meta::Method::Overriden');
134 sub add_augment_method_modifier {
135 my ($self, $name, $method) = @_;
136 (!$self->has_method($name))
137 || confess "Cannot add an augment method if a local method is already present";
138 my $super = $self->find_next_method_by_name($name);
140 || confess "You cannot augment '$name' because it has no super method";
141 my $_super_package = $super->package_name;
142 # BUT!,... if this is an overriden method ....
143 if ($super->isa('Moose::Meta::Method::Overriden')) {
144 # we need to be sure that we actually
145 # find the next method, which is not
146 # an 'override' method, the reason is
147 # that an 'override' method will not
148 # be the one calling inner()
149 my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
150 $_super_package = $real_super->package_name;
152 $self->add_method($name => sub {
155 no warnings 'redefine';
156 local *{$_super_package . '::inner'} = sub { $method->(@args) };
157 return $super->(@args);
161 sub _find_next_method_by_name_which_is_not_overridden {
162 my ($self, $name) = @_;
163 my @methods = $self->find_all_methods_by_name($name);
164 foreach my $method (@methods) {
165 return $method->{code}
166 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
171 package Moose::Meta::Method::Overriden;
176 our $VERSION = '0.01';
178 use base 'Class::MOP::Method';
188 Moose::Meta::Class - The Moose metaclass
192 This is a subclass of L<Class::MOP::Class> with Moose specific
195 For the most part, the only time you will ever encounter an
196 instance of this class is if you are doing some serious deep
197 introspection. To really understand this class, you need to refer
198 to the L<Class::MOP::Class> documentation.
208 We override this method to support the C<trigger> attribute option.
210 =item B<construct_instance>
212 This provides some Moose specific extensions to this method, you
213 almost never call this method directly unless you really know what
216 This method makes sure to handle the moose weak-ref, type-constraint
217 and type coercion features.
219 =item B<has_method ($name)>
221 This accomidates Moose::Meta::Role::Method instances, which are
222 aliased, instead of added, but still need to be counted as valid
225 =item B<add_override_method_modifier ($name, $method)>
227 This will create an C<override> method modifier for you, and install
230 =item B<add_augment_method_modifier ($name, $method)>
232 This will create an C<augment> method modifier for you, and install
237 This will return an array of C<Moose::Meta::Role> instances which are
238 attached to this class.
240 =item B<add_role ($role)>
242 This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
243 to the list of associated roles.
245 =item B<does_role ($role_name)>
247 This will test if this class C<does> a given C<$role_name>. It will
248 not only check it's local roles, but ask them as well in order to
249 cascade down the role hierarchy.
251 =item B<excludes_role ($role_name)>
253 This will test if this class C<excludes> a given C<$role_name>. It will
254 not only check it's local roles, but ask them as well in order to
255 cascade down the role hierarchy.
257 =item B<add_attribute $attr_name, %params>
259 This method does the same thing as L<Class::MOP::Class/add_attribute>, but adds
260 suport for delegation.
264 =head1 INTERNAL METHODS
268 =item compute_delegation
270 =item generate_delegation_list
272 =item generate_delgate_method
274 =item get_delegatable_methods
276 =item filter_delegations
282 All complex software has bugs lurking in it, and this module is no
283 exception. If you find a bug please either email me, or add the bug
288 Stevan Little E<lt>stevan@iinteractive.comE<gt>
290 =head1 COPYRIGHT AND LICENSE
292 Copyright 2006 by Infinity Interactive, Inc.
294 L<http://www.iinteractive.com>
296 This library is free software; you can redistribute it and/or modify
297 it under the same terms as Perl itself.