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' => (
22 my ($self, $role) = @_;
23 (blessed($role) && $role->isa('Moose::Meta::Role'))
24 || confess "Roles must be instances of Moose::Meta::Role";
25 push @{$self->roles} => $role;
29 my ($self, $role_name) = @_;
31 || confess "You must supply a role name to look for";
32 foreach my $role (@{$self->roles}) {
33 return 1 if $role->does_role($role_name);
39 my ($class, %params) = @_;
40 my $self = $class->SUPER::new_object(%params);
41 foreach my $attr ($class->compute_all_applicable_attributes()) {
42 next unless $params{$attr->name} && $attr->has_trigger;
43 $attr->trigger->($self, $params{$attr->name});
48 sub construct_instance {
49 my ($class, %params) = @_;
50 my $instance = $params{'__INSTANCE__'} || {};
51 foreach my $attr ($class->compute_all_applicable_attributes()) {
52 my $init_arg = $attr->init_arg();
53 # try to fetch the init arg from the %params ...
55 if (exists $params{$init_arg}) {
56 $val = $params{$init_arg};
59 # skip it if it's lazy
60 next if $attr->is_lazy;
61 # and die if it's required and doesn't have a default value
62 confess "Attribute (" . $attr->name . ") is required"
63 if $attr->is_required && !$attr->has_default;
65 # if nothing was in the %params, we can use the
66 # attribute's default value (if it has one)
67 if (!defined $val && $attr->has_default) {
68 $val = $attr->default($instance);
71 if ($attr->has_type_constraint) {
72 if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
73 $val = $attr->type_constraint->coercion->coerce($val);
75 (defined($attr->type_constraint->check($val)))
76 || confess "Attribute (" . $attr->name . ") does not pass the type contraint with '$val'";
79 $instance->{$attr->name} = $val;
80 if (defined $val && $attr->is_weak_ref) {
81 weaken($instance->{$attr->name});
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);
103 sub add_override_method_modifier {
104 my ($self, $name, $method, $_super_package) = @_;
105 # need this for roles ...
106 $_super_package ||= $self->name;
107 my $super = $self->find_next_method_by_name($name);
109 || confess "You cannot override '$name' because it has no super method";
110 $self->add_method($name => bless sub {
113 no warnings 'redefine';
114 local *{$_super_package . '::super'} = sub { $super->(@args) };
115 return $method->(@args);
116 } => 'Moose::Meta::Method::Overriden');
119 sub add_augment_method_modifier {
120 my ($self, $name, $method) = @_;
121 my $super = $self->find_next_method_by_name($name);
123 || confess "You cannot augment '$name' because it has no super method";
124 my $_super_package = $super->package_name;
125 # BUT!,... if this is an overriden method ....
126 if ($super->isa('Moose::Meta::Method::Overriden')) {
127 # we need to be sure that we actually
128 # find the next method, which is not
129 # an 'override' method, the reason is
130 # that an 'override' method will not
131 # be the one calling inner()
132 my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
133 $_super_package = $real_super->package_name;
135 $self->add_method($name => sub {
138 no warnings 'redefine';
139 local *{$_super_package . '::inner'} = sub { $method->(@args) };
140 return $super->(@args);
144 sub _find_next_method_by_name_which_is_not_overridden {
145 my ($self, $name) = @_;
146 my @methods = $self->find_all_methods_by_name($name);
147 foreach my $method (@methods) {
148 return $method->{code}
149 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
154 package Moose::Meta::Method::Overriden;
159 our $VERSION = '0.01';
161 use base 'Class::MOP::Method';
171 Moose::Meta::Class - The Moose metaclass
175 This is a subclass of L<Class::MOP::Class> with Moose specific
178 For the most part, the only time you will ever encounter an
179 instance of this class is if you are doing some serious deep
180 introspection. To really understand this class, you need to refer
181 to the L<Class::MOP::Class> documentation.
189 We override this method to support the C<trigger> attribute option.
191 =item B<construct_instance>
193 This provides some Moose specific extensions to this method, you
194 almost never call this method directly unless you really know what
197 This method makes sure to handle the moose weak-ref, type-constraint
198 and type coercion features.
200 =item B<has_method ($name)>
202 This accomidates Moose::Meta::Role::Method instances, which are
203 aliased, instead of added, but still need to be counted as valid
206 =item B<add_override_method_modifier ($name, $method)>
208 This will create an C<override> method modifier for you, and install
211 =item B<add_augment_method_modifier ($name, $method)>
213 This will create an C<augment> method modifier for you, and install
218 This will return an array of C<Moose::Meta::Role> instances which are
219 attached to this class.
221 =item B<add_role ($role)>
223 This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
224 to the list of associated roles.
226 =item B<does_role ($role_name)>
228 This will test if this class C<does> a given C<$role_name>. It will
229 not only check it's local roles, but ask them as well in order to
230 cascade down the role hierarchy.
236 All complex software has bugs lurking in it, and this module is no
237 exception. If you find a bug please either email me, or add the bug
242 Stevan Little E<lt>stevan@iinteractive.comE<gt>
244 =head1 COPYRIGHT AND LICENSE
246 Copyright 2006 by Infinity Interactive, Inc.
248 L<http://www.iinteractive.com>
250 This library is free software; you can redistribute it and/or modify
251 it under the same terms as Perl itself.