2 package Moose::Meta::Class;
10 use Scalar::Util 'weaken', 'blessed';
12 our $VERSION = '0.04';
14 use base 'Class::MOP::Class';
16 __PACKAGE__->meta->add_attribute('roles' => (
24 $class->SUPER::initialize($pkg,
25 ':attribute_metaclass' => 'Moose::Meta::Attribute',
30 my ($self, $role) = @_;
31 (blessed($role) && $role->isa('Moose::Meta::Role'))
32 || confess "Roles must be instances of Moose::Meta::Role";
33 push @{$self->roles} => $role;
37 my ($self, $role_name) = @_;
39 || confess "You must supply a role name to look for";
40 foreach my $role (@{$self->roles}) {
41 return 1 if $role->does_role($role_name);
47 my ($class, %params) = @_;
48 my $self = $class->SUPER::new_object(%params);
49 foreach my $attr ($class->compute_all_applicable_attributes()) {
50 next unless $params{$attr->name} && $attr->has_trigger;
51 $attr->trigger->($self, $params{$attr->name});
56 sub construct_instance {
57 my ($class, %params) = @_;
58 my $instance = $params{'__INSTANCE__'} || {};
59 foreach my $attr ($class->compute_all_applicable_attributes()) {
60 my $init_arg = $attr->init_arg();
61 # try to fetch the init arg from the %params ...
63 if (exists $params{$init_arg}) {
64 $val = $params{$init_arg};
67 # skip it if it's lazy
68 next if $attr->is_lazy;
69 # and die if it's required and doesn't have a default value
70 confess "Attribute (" . $attr->name . ") is required"
71 if $attr->is_required && !$attr->has_default;
73 # if nothing was in the %params, we can use the
74 # attribute's default value (if it has one)
75 if (!defined $val && $attr->has_default) {
76 $val = $attr->default($instance);
79 if ($attr->has_type_constraint) {
80 if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
81 $val = $attr->type_constraint->coercion->coerce($val);
83 (defined($attr->type_constraint->check($val)))
84 || confess "Attribute (" . $attr->name . ") does not pass the type contraint with '$val'";
87 $instance->{$attr->name} = $val;
88 if (defined $val && $attr->is_weak_ref) {
89 weaken($instance->{$attr->name});
96 my ($self, $method_name) = @_;
97 (defined $method_name && $method_name)
98 || confess "You must define a method name";
100 my $sub_name = ($self->name . '::' . $method_name);
103 return 0 if !defined(&{$sub_name});
104 my $method = \&{$sub_name};
106 return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method');
107 return $self->SUPER::has_method($method_name);
111 sub add_override_method_modifier {
112 my ($self, $name, $method, $_super_package) = @_;
113 # need this for roles ...
114 $_super_package ||= $self->name;
115 my $super = $self->find_next_method_by_name($name);
117 || confess "You cannot override '$name' because it has no super method";
118 $self->add_method($name => bless sub {
121 no warnings 'redefine';
122 local *{$_super_package . '::super'} = sub { $super->(@args) };
123 return $method->(@args);
124 } => 'Moose::Meta::Method::Overriden');
127 sub add_augment_method_modifier {
128 my ($self, $name, $method) = @_;
129 my $super = $self->find_next_method_by_name($name);
131 || confess "You cannot augment '$name' because it has no super method";
132 my $_super_package = $super->package_name;
133 # BUT!,... if this is an overriden method ....
134 if ($super->isa('Moose::Meta::Method::Overriden')) {
135 # we need to be sure that we actually
136 # find the next method, which is not
137 # an 'override' method, the reason is
138 # that an 'override' method will not
139 # be the one calling inner()
140 my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
141 $_super_package = $real_super->package_name;
143 $self->add_method($name => sub {
146 no warnings 'redefine';
147 local *{$_super_package . '::inner'} = sub { $method->(@args) };
148 return $super->(@args);
152 sub _find_next_method_by_name_which_is_not_overridden {
153 my ($self, $name) = @_;
154 my @methods = $self->find_all_methods_by_name($name);
155 foreach my $method (@methods) {
156 return $method->{code}
157 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
162 package Moose::Meta::Method::Overriden;
167 our $VERSION = '0.01';
169 use base 'Class::MOP::Method';
179 Moose::Meta::Class - The Moose metaclass
183 This is a subclass of L<Class::MOP::Class> with Moose specific
186 For the most part, the only time you will ever encounter an
187 instance of this class is if you are doing some serious deep
188 introspection. To really understand this class, you need to refer
189 to the L<Class::MOP::Class> documentation.
199 We override this method to support the C<trigger> attribute option.
201 =item B<construct_instance>
203 This provides some Moose specific extensions to this method, you
204 almost never call this method directly unless you really know what
207 This method makes sure to handle the moose weak-ref, type-constraint
208 and type coercion features.
210 =item B<has_method ($name)>
212 This accomidates Moose::Meta::Role::Method instances, which are
213 aliased, instead of added, but still need to be counted as valid
216 =item B<add_override_method_modifier ($name, $method)>
218 This will create an C<override> method modifier for you, and install
221 =item B<add_augment_method_modifier ($name, $method)>
223 This will create an C<augment> method modifier for you, and install
228 This will return an array of C<Moose::Meta::Role> instances which are
229 attached to this class.
231 =item B<add_role ($role)>
233 This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
234 to the list of associated roles.
236 =item B<does_role ($role_name)>
238 This will test if this class C<does> a given C<$role_name>. It will
239 not only check it's local roles, but ask them as well in order to
240 cascade down the role hierarchy.
246 All complex software has bugs lurking in it, and this module is no
247 exception. If you find a bug please either email me, or add the bug
252 Stevan Little E<lt>stevan@iinteractive.comE<gt>
254 =head1 COPYRIGHT AND LICENSE
256 Copyright 2006 by Infinity Interactive, Inc.
258 L<http://www.iinteractive.com>
260 This library is free software; you can redistribute it and/or modify
261 it under the same terms as Perl itself.