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 next unless $class->can('meta');
43 foreach my $role (@{$class->meta->roles}) {
44 return 1 if $role->does_role($role_name);
51 my ($self, $role_name) = @_;
53 || confess "You must supply a role name to look for";
54 foreach my $class ($self->class_precedence_list) {
55 next unless $class->can('meta');
56 foreach my $role (@{$class->meta->roles}) {
57 return 1 if $role->excludes_role($role_name);
64 my ($class, %params) = @_;
65 my $self = $class->SUPER::new_object(%params);
66 foreach my $attr ($class->compute_all_applicable_attributes()) {
67 next unless $params{$attr->init_arg} && $attr->can('has_trigger') && $attr->has_trigger;
68 $attr->trigger->($self, $params{$attr->init_arg}, $attr);
73 sub construct_instance {
74 my ($class, %params) = @_;
75 my $meta_instance = $class->get_meta_instance;
77 # the code below is almost certainly incorrect
78 # but this is foreign inheritence, so we might
79 # have to kludge it in the end.
80 my $instance = $params{'__INSTANCE__'} || $meta_instance->create_instance();
81 foreach my $attr ($class->compute_all_applicable_attributes()) {
82 $attr->initialize_instance_slot($meta_instance, $instance, \%params)
88 my ($self, $method_name) = @_;
89 (defined $method_name && $method_name)
90 || confess "You must define a method name";
92 my $sub_name = ($self->name . '::' . $method_name);
95 return 0 if !defined(&{$sub_name});
96 my $method = \&{$sub_name};
98 return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method');
99 return $self->SUPER::has_method($method_name);
105 if (scalar @_ == 1 && ref($_[0]) eq 'HASH') {
107 # if it is a HASH ref, we de-ref it.
108 # this will usually mean that it is
110 $self->SUPER::add_attribute($name => %{$_[0]});
113 # otherwise we just pass the args
114 $self->SUPER::add_attribute($name => @_);
118 sub add_override_method_modifier {
119 my ($self, $name, $method, $_super_package) = @_;
120 (!$self->has_method($name))
121 || confess "Cannot add an override method if a local method is already present";
122 # need this for roles ...
123 $_super_package ||= $self->name;
124 my $super = $self->find_next_method_by_name($name);
126 || confess "You cannot override '$name' because it has no super method";
127 $self->add_method($name => bless sub {
130 no warnings 'redefine';
131 local *{$_super_package . '::super'} = sub { $super->(@args) };
132 return $method->(@args);
133 } => 'Moose::Meta::Method::Overriden');
136 sub add_augment_method_modifier {
137 my ($self, $name, $method) = @_;
138 (!$self->has_method($name))
139 || confess "Cannot add an augment method if a local method is already present";
140 my $super = $self->find_next_method_by_name($name);
142 || confess "You cannot augment '$name' because it has no super method";
143 my $_super_package = $super->package_name;
144 # BUT!,... if this is an overriden method ....
145 if ($super->isa('Moose::Meta::Method::Overriden')) {
146 # we need to be sure that we actually
147 # find the next method, which is not
148 # an 'override' method, the reason is
149 # that an 'override' method will not
150 # be the one calling inner()
151 my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
152 $_super_package = $real_super->package_name;
154 $self->add_method($name => sub {
157 no warnings 'redefine';
158 local *{$_super_package . '::inner'} = sub { $method->(@args) };
159 return $super->(@args);
163 sub _find_next_method_by_name_which_is_not_overridden {
164 my ($self, $name) = @_;
165 my @methods = $self->find_all_methods_by_name($name);
166 foreach my $method (@methods) {
167 return $method->{code}
168 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
173 package Moose::Meta::Method::Overriden;
178 our $VERSION = '0.01';
180 use base 'Class::MOP::Method';
190 Moose::Meta::Class - The Moose metaclass
194 This is a subclass of L<Class::MOP::Class> with Moose specific
197 For the most part, the only time you will ever encounter an
198 instance of this class is if you are doing some serious deep
199 introspection. To really understand this class, you need to refer
200 to the L<Class::MOP::Class> documentation.
210 We override this method to support the C<trigger> attribute option.
212 =item B<construct_instance>
214 This provides some Moose specific extensions to this method, you
215 almost never call this method directly unless you really know what
218 This method makes sure to handle the moose weak-ref, type-constraint
219 and type coercion features.
221 =item B<has_method ($name)>
223 This accomidates Moose::Meta::Role::Method instances, which are
224 aliased, instead of added, but still need to be counted as valid
227 =item B<add_override_method_modifier ($name, $method)>
229 This will create an C<override> method modifier for you, and install
232 =item B<add_augment_method_modifier ($name, $method)>
234 This will create an C<augment> method modifier for you, and install
239 This will return an array of C<Moose::Meta::Role> instances which are
240 attached to this class.
242 =item B<add_role ($role)>
244 This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
245 to the list of associated roles.
247 =item B<does_role ($role_name)>
249 This will test if this class C<does> a given C<$role_name>. It will
250 not only check it's local roles, but ask them as well in order to
251 cascade down the role hierarchy.
253 =item B<excludes_role ($role_name)>
255 This will test if this class C<excludes> a given C<$role_name>. It will
256 not only check it's local roles, but ask them as well in order to
257 cascade down the role hierarchy.
259 =item B<add_attribute ($attr_name, %params|$params)>
261 This method does the same thing as L<Class::MOP::Class::add_attribute>, but adds
262 support for taking the C<$params> as a HASH ref.
268 All complex software has bugs lurking in it, and this module is no
269 exception. If you find a bug please either email me, or add the bug
274 Stevan Little E<lt>stevan@iinteractive.comE<gt>
276 =head1 COPYRIGHT AND LICENSE
278 Copyright 2006 by Infinity Interactive, Inc.
280 L<http://www.iinteractive.com>
282 This library is free software; you can redistribute it and/or modify
283 it under the same terms as Perl itself.