2 package Moose::Meta::Class;
8 use Scalar::Util 'weaken', 'blessed';
10 our $VERSION = '0.04';
12 use base 'Class::MOP::Class';
14 __PACKAGE__->meta->add_attribute('roles' => (
20 my ($self, $role) = @_;
21 (blessed($role) && $role->isa('Moose::Meta::Role'))
22 || confess "Roles must be instances of Moose::Meta::Role";
23 push @{$self->roles} => $role;
27 my ($self, $role_name) = @_;
29 || confess "You must supply a role name to look for";
30 foreach my $role (@{$self->roles}) {
31 return 1 if $role->name eq $role_name;
36 sub construct_instance {
37 my ($class, %params) = @_;
38 my $instance = $params{'__INSTANCE__'} || {};
39 foreach my $attr ($class->compute_all_applicable_attributes()) {
40 my $init_arg = $attr->init_arg();
41 # try to fetch the init arg from the %params ...
43 if (exists $params{$init_arg}) {
44 $val = $params{$init_arg};
47 # skip it if it's lazy
48 next if $attr->is_lazy;
49 # and die if it is required
50 confess "Attribute (" . $attr->name . ") is required"
53 # if nothing was in the %params, we can use the
54 # attribute's default value (if it has one)
55 if (!defined $val && $attr->has_default) {
56 $val = $attr->default($instance);
59 if ($attr->has_type_constraint) {
60 if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
61 $val = $attr->type_constraint->coercion->coerce($val);
63 (defined($attr->type_constraint->check($val)))
64 || confess "Attribute (" . $attr->name . ") does not pass the type contraint with '$val'";
67 $instance->{$attr->name} = $val;
68 if (defined $val && $attr->is_weak_ref) {
69 weaken($instance->{$attr->name});
76 my ($self, $method_name) = @_;
77 (defined $method_name && $method_name)
78 || confess "You must define a method name";
80 my $sub_name = ($self->name . '::' . $method_name);
83 return 0 if !defined(&{$sub_name});
84 my $method = \&{$sub_name};
86 return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method');
87 return $self->SUPER::has_method($method_name);
91 sub add_override_method_modifier {
92 my ($self, $name, $method, $_super_package) = @_;
93 # need this for roles ...
94 $_super_package ||= $self->name;
95 my $super = $self->find_next_method_by_name($name);
97 || confess "You cannot override '$name' because it has no super method";
98 $self->add_method($name => bless sub {
101 no warnings 'redefine';
102 local *{$_super_package . '::super'} = sub { $super->(@args) };
103 return $method->(@args);
104 } => 'Moose::Meta::Method::Overriden');
107 sub add_augment_method_modifier {
108 my ($self, $name, $method) = @_;
109 my $super = $self->find_next_method_by_name($name);
111 || confess "You cannot augment '$name' because it has no super method";
112 my $_super_package = $super->package_name;
113 # BUT!,... if this is an overriden method ....
114 if ($super->isa('Moose::Meta::Method::Overriden')) {
115 # we need to be sure that we actually
116 # find the next method, which is not
117 # an 'override' method, the reason is
118 # that an 'override' method will not
119 # be the one calling inner()
120 my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
121 $_super_package = $real_super->package_name;
123 $self->add_method($name => sub {
126 no warnings 'redefine';
127 local *{$_super_package . '::inner'} = sub { $method->(@args) };
128 return $super->(@args);
132 sub _find_next_method_by_name_which_is_not_overridden {
133 my ($self, $name) = @_;
134 my @methods = $self->find_all_methods_by_name($name);
135 foreach my $method (@methods) {
136 return $method->{code}
137 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
142 package Moose::Meta::Method::Overriden;
147 our $VERSION = '0.01';
149 use base 'Class::MOP::Method';
159 Moose::Meta::Class - The Moose metaclass
163 This is a subclass of L<Class::MOP::Class> with Moose specific
166 For the most part, the only time you will ever encounter an
167 instance of this class is if you are doing some serious deep
168 introspection. To really understand this class, you need to refer
169 to the L<Class::MOP::Class> documentation.
175 =item B<construct_instance>
177 This provides some Moose specific extensions to this method, you
178 almost never call this method directly unless you really know what
181 This method makes sure to handle the moose weak-ref, type-constraint
182 and type coercion features.
184 =item B<has_method ($name)>
186 This accomidates Moose::Meta::Role::Method instances, which are
187 aliased, instead of added, but still need to be counted as valid
190 =item B<add_override_method_modifier ($name, $method)>
192 =item B<add_augment_method_modifier ($name, $method)>
196 =item B<add_role ($role)>
198 =item B<does_role ($role_name)>
204 All complex software has bugs lurking in it, and this module is no
205 exception. If you find a bug please either email me, or add the bug
210 Stevan Little E<lt>stevan@iinteractive.comE<gt>
212 =head1 COPYRIGHT AND LICENSE
214 Copyright 2006 by Infinity Interactive, Inc.
216 L<http://www.iinteractive.com>
218 This library is free software; you can redistribute it and/or modify
219 it under the same terms as Perl itself.