2 package Moose::Meta::Class;
9 use Carp qw( confess );
11 use List::Util qw( first );
12 use List::MoreUtils qw( any all uniq first_index );
13 use Scalar::Util 'weaken', 'blessed';
15 use Moose::Meta::Method::Overridden;
16 use Moose::Meta::Method::Augmented;
17 use Moose::Error::Default;
18 use Moose::Meta::Class::Immutable::Trait;
19 use Moose::Meta::Method::Constructor;
20 use Moose::Meta::Method::Destructor;
21 use Moose::Meta::Method::Meta;
23 use Class::MOP::MiniTrait;
25 use base 'Class::MOP::Class';
27 Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
29 __PACKAGE__->meta->add_attribute('roles' => (
34 __PACKAGE__->meta->add_attribute('role_applications' => (
35 reader => '_get_role_applications',
39 __PACKAGE__->meta->add_attribute(
40 Class::MOP::Attribute->new('immutable_trait' => (
41 accessor => "immutable_trait",
42 default => 'Moose::Meta::Class::Immutable::Trait',
46 __PACKAGE__->meta->add_attribute('constructor_class' => (
47 accessor => 'constructor_class',
48 default => 'Moose::Meta::Method::Constructor',
51 __PACKAGE__->meta->add_attribute('destructor_class' => (
52 accessor => 'destructor_class',
53 default => 'Moose::Meta::Method::Destructor',
56 __PACKAGE__->meta->add_attribute('error_class' => (
57 accessor => 'error_class',
58 default => 'Moose::Error::Default',
64 return Class::MOP::get_metaclass_by_name($pkg)
65 || $class->SUPER::initialize($pkg,
66 'attribute_metaclass' => 'Moose::Meta::Attribute',
67 'method_metaclass' => 'Moose::Meta::Method',
68 'instance_metaclass' => 'Moose::Meta::Instance',
74 my ($class, $package_name, %options) = @_;
76 (ref $options{roles} eq 'ARRAY')
77 || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
78 if exists $options{roles};
79 my $roles = delete $options{roles};
81 my $new_meta = $class->SUPER::create($package_name, %options);
84 Moose::Util::apply_all_roles( $new_meta, @$roles );
92 sub create_anon_class {
93 my ($self, %options) = @_;
95 my $cache_ok = delete $options{cache};
98 = _anon_cache_key( $options{superclasses}, $options{roles} );
100 if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
101 return $ANON_CLASSES{$cache_key};
104 $options{weaken} = !$cache_ok
105 unless exists $options{weaken};
107 my $new_class = $self->SUPER::create_anon_class(%options);
110 $ANON_CLASSES{$cache_key} = $new_class;
111 weaken($ANON_CLASSES{$cache_key});
117 sub _meta_method_class { 'Moose::Meta::Method::Meta' }
119 sub _anon_cache_key {
120 # Makes something like Super::Class|Super::Class::2=Role|Role::1
122 join( '|', @{ $_[0] || [] } ),
123 join( '|', sort @{ $_[1] || [] } ),
131 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
135 my %existing_classes;
137 %existing_classes = map { $_ => $meta->$_() } qw(
140 wrapped_method_metaclass
147 $cache_key = _anon_cache_key(
148 [ $meta->superclasses ],
149 [ map { $_->name } @{ $meta->roles } ],
150 ) if $meta->is_anon_class;
153 my $new_meta = $self->SUPER::reinitialize(
159 return $new_meta unless defined $cache_key;
161 my $new_cache_key = _anon_cache_key(
162 [ $meta->superclasses ],
163 [ map { $_->name } @{ $meta->roles } ],
166 delete $ANON_CLASSES{$cache_key};
167 $ANON_CLASSES{$new_cache_key} = $new_meta;
168 weaken($ANON_CLASSES{$new_cache_key});
174 my ($self, $role) = @_;
175 (blessed($role) && $role->isa('Moose::Meta::Role'))
176 || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
177 push @{$self->roles} => $role;
180 sub role_applications {
183 return @{$self->_get_role_applications};
186 sub add_role_application {
187 my ($self, $application) = @_;
188 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
189 || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
190 push @{$self->_get_role_applications} => $application;
193 sub calculate_all_roles {
196 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
199 sub calculate_all_roles_with_inheritance {
202 grep { !$seen{$_->name}++ }
203 map { Class::MOP::class_of($_)->can('calculate_all_roles')
204 ? Class::MOP::class_of($_)->calculate_all_roles
206 $self->linearized_isa;
210 my ($self, $role_name) = @_;
213 || $self->throw_error("You must supply a role name to look for");
215 foreach my $class ($self->class_precedence_list) {
216 my $meta = Class::MOP::class_of($class);
217 # when a Moose metaclass is itself extended with a role,
218 # this check needs to be done since some items in the
219 # class_precedence_list might in fact be Class::MOP
221 next unless $meta && $meta->can('roles');
222 foreach my $role (@{$meta->roles}) {
223 return 1 if $role->does_role($role_name);
230 my ($self, $role_name) = @_;
233 || $self->throw_error("You must supply a role name to look for");
235 foreach my $class ($self->class_precedence_list) {
236 my $meta = Class::MOP::class_of($class);
237 # when a Moose metaclass is itself extended with a role,
238 # this check needs to be done since some items in the
239 # class_precedence_list might in fact be Class::MOP
241 next unless $meta && $meta->can('roles');
242 foreach my $role (@{$meta->roles}) {
243 return 1 if $role->excludes_role($role_name);
251 my $params = @_ == 1 ? $_[0] : {@_};
252 my $object = $self->SUPER::new_object($params);
254 foreach my $attr ( $self->get_all_attributes() ) {
256 next unless $attr->can('has_trigger') && $attr->has_trigger;
258 my $init_arg = $attr->init_arg;
260 next unless defined $init_arg;
262 next unless exists $params->{$init_arg};
268 ? $attr->get_read_method_ref->($object)
269 : $params->{$init_arg}
274 $object->BUILDALL($params) if $object->can('BUILDALL');
279 sub _generate_fallback_constructor {
282 return $class . '->Moose::Object::new(@_)'
287 my ($params, $class) = @_;
289 'my ' . $params . ' = ',
290 $self->_inline_BUILDARGS($class, '@_'),
295 sub _inline_BUILDARGS {
297 my ($class, $args) = @_;
299 my $buildargs = $self->find_method_by_name("BUILDARGS");
302 && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
306 'if (scalar @_ == 1) {',
307 'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
308 $self->_inline_throw_error(
309 '"Single parameters to new() must be a HASH ref"',
313 '$params = { %{ $_[0] } };',
317 '"The new() method for ' . $class . ' expects a '
318 . 'hash reference or a key/value list. You passed an '
319 . 'odd number of arguments"',
321 '$params = {@_, undef};',
331 return $class . '->BUILDARGS(' . $args . ')';
335 sub _inline_slot_initializer {
337 my ($attr, $idx) = @_;
341 $self->_inline_check_required_attr($attr),
342 $self->SUPER::_inline_slot_initializer(@_),
346 sub _inline_check_required_attr {
350 return unless defined $attr->init_arg;
351 return unless $attr->can('is_required') && $attr->is_required;
352 return if $attr->has_default || $attr->has_builder;
355 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
356 $self->_inline_throw_error(
357 '"Attribute (' . quotemeta($attr->name) . ') is required"'
363 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
364 # through to _inline_set_value - this should probably be fixed, but i'm not
365 # quite sure how. -doy
366 sub _inline_init_attr_from_constructor {
368 my ($attr, $idx) = @_;
370 my @initial_value = $attr->_inline_set_value(
372 '$params->{\'' . $attr->init_arg . '\'}',
373 '$type_constraint_bodies[' . $idx . ']',
374 '$type_constraints[' . $idx . ']',
378 push @initial_value, (
379 '$attrs->[' . $idx . ']->set_initial_value(',
381 $attr->_inline_instance_get('$instance'),
383 ) if $attr->has_initializer;
385 return @initial_value;
388 sub _inline_init_attr_from_default {
390 my ($attr, $idx) = @_;
392 return if $attr->can('is_lazy') && $attr->is_lazy;
393 my $default = $self->_inline_default_value($attr, $idx);
394 return unless $default;
396 my @initial_value = (
397 'my $default = ' . $default . ';',
398 $attr->_inline_set_value(
401 '$type_constraint_bodies[' . $idx . ']',
402 '$type_constraints[' . $idx . ']',
407 push @initial_value, (
408 '$attrs->[' . $idx . ']->set_initial_value(',
410 $attr->_inline_instance_get('$instance'),
412 ) if $attr->has_initializer;
414 return @initial_value;
417 sub _inline_extra_init {
420 $self->_inline_triggers,
421 $self->_inline_BUILDALL,
425 sub _inline_triggers {
429 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
430 for my $i (0 .. $#attrs) {
431 my $attr = $attrs[$i];
433 next unless $attr->can('has_trigger') && $attr->has_trigger;
435 my $init_arg = $attr->init_arg;
436 next unless defined $init_arg;
439 'if (exists $params->{\'' . $init_arg . '\'}) {',
440 '$attrs->[' . $i . ']->trigger->(',
442 $attr->_inline_instance_get('$instance') . ',',
447 return @trigger_calls;
450 sub _inline_BUILDALL {
453 my @methods = reverse $self->find_all_methods_by_name('BUILD');
456 foreach my $method (@methods) {
458 '$instance->' . $method->{class} . '::BUILD($params);';
466 my $supers = Data::OptList::mkopt(\@_);
467 foreach my $super (@{ $supers }) {
468 my ($name, $opts) = @{ $super };
469 Class::MOP::load_class($name, $opts);
470 my $meta = Class::MOP::class_of($name);
471 $self->throw_error("You cannot inherit from a Moose Role ($name)")
472 if $meta && $meta->isa('Moose::Meta::Role')
474 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
477 ### ---------------------------------------------
482 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
484 : $self->_process_attribute(@_));
485 $self->SUPER::add_attribute($attr);
486 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
487 # 'bare' and doesn't implement this method
488 if ($attr->can('_check_associated_methods')) {
489 $attr->_check_associated_methods;
494 sub add_override_method_modifier {
495 my ($self, $name, $method, $_super_package) = @_;
497 (!$self->has_method($name))
498 || $self->throw_error("Cannot add an override method if a local method is already present");
500 $self->add_method($name => Moose::Meta::Method::Overridden->new(
503 package => $_super_package, # need this for roles
508 sub add_augment_method_modifier {
509 my ($self, $name, $method) = @_;
510 (!$self->has_method($name))
511 || $self->throw_error("Cannot add an augment method if a local method is already present");
513 $self->add_method($name => Moose::Meta::Method::Augmented->new(
520 ## Private Utility methods ...
522 sub _find_next_method_by_name_which_is_not_overridden {
523 my ($self, $name) = @_;
524 foreach my $method ($self->find_all_methods_by_name($name)) {
525 return $method->{code}
526 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
531 ## Metaclass compatibility
533 sub _base_metaclasses {
535 my %metaclasses = $self->SUPER::_base_metaclasses;
536 for my $class (keys %metaclasses) {
537 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
541 error_class => 'Moose::Error::Default',
545 sub _fix_class_metaclass_incompatibility {
547 my ($super_meta) = @_;
549 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
551 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
553 || confess "Can't fix metaclass incompatibility for "
555 . " because it is not pristine.";
556 my $super_meta_name = $super_meta->_real_ref_name;
557 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
558 my $new_self = $class_meta_subclass_meta_name->reinitialize(
562 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
566 sub _fix_single_metaclass_incompatibility {
568 my ($metaclass_type, $super_meta) = @_;
570 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
572 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
574 || confess "Can't fix metaclass incompatibility for "
576 . " because it is not pristine.";
577 my $super_meta_name = $super_meta->_real_ref_name;
578 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
579 my $new_self = $super_meta->reinitialize(
581 $metaclass_type => $class_specific_meta_subclass_meta_name,
584 $self->_replace_self( $new_self, $super_meta_name );
590 my ( $new_self, $new_class) = @_;
593 bless $self, $new_class;
595 # We need to replace the cached metaclass instance or else when it goes
596 # out of scope Class::MOP::Class destroy's the namespace for the
597 # metaclass's class, causing much havoc.
598 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
599 Class::MOP::store_metaclass_by_name( $self->name, $self );
600 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
603 sub _process_attribute {
604 my ( $self, $name, @args ) = @_;
606 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
608 if (($name || '') =~ /^\+(.*)/) {
609 return $self->_process_inherited_attribute($1, @args);
612 return $self->_process_new_attribute($name, @args);
616 sub _process_new_attribute {
617 my ( $self, $name, @args ) = @_;
619 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
622 sub _process_inherited_attribute {
623 my ($self, $attr_name, %options) = @_;
624 my $inherited_attr = $self->find_attribute_by_name($attr_name);
625 (defined $inherited_attr)
626 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
627 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
628 return $inherited_attr->clone_and_inherit_options(%options);
632 # kind of a kludge to handle Class::MOP::Attributes
633 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
637 # reinitialization support
639 sub _restore_metaobjects_from {
643 $self->SUPER::_restore_metaobjects_from($old_meta);
645 for my $role ( @{ $old_meta->roles } ) {
646 $self->add_role($role);
649 for my $application ( @{ $old_meta->_get_role_applications } ) {
650 $application->class($self);
651 $self->add_role_application ($application);
657 sub _immutable_options {
658 my ( $self, @args ) = @_;
660 $self->SUPER::_immutable_options(
661 inline_destructor => 1,
663 # Moose always does this when an attribute is created
664 inline_accessors => 0,
670 ## -------------------------------------------------
675 my ( $self, @args ) = @_;
676 local $error_level = ($error_level || 0) + 1;
677 $self->raise_error($self->create_error(@args));
680 sub _inline_throw_error {
681 my ( $self, $msg, $args ) = @_;
682 "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
686 my ( $self, @args ) = @_;
691 my ( $self, @args ) = @_;
695 local $error_level = ($error_level || 0 ) + 1;
697 if ( @args % 2 == 1 ) {
698 unshift @args, "message";
701 my %args = ( metaclass => $self, last_error => $@, @args );
703 $args{depth} += $error_level;
705 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
707 Class::MOP::load_class($class);
710 Carp::caller_info($args{depth}),
717 # ABSTRACT: The Moose metaclass
725 This class is a subclass of L<Class::MOP::Class> that provides
726 additional Moose-specific functionality.
728 To really understand this class, you will need to start with the
729 L<Class::MOP::Class> documentation. This class can be understood as a
730 set of additional features on top of the basic feature provided by
735 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
741 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
743 This overrides the parent's method in order to provide its own
744 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
745 C<method_metaclass> options.
747 These all default to the appropriate Moose class.
749 =item B<< Moose::Meta::Class->create($package_name, %options) >>
751 This overrides the parent's method in order to accept a C<roles>
752 option. This should be an array reference containing roles
753 that the class does, each optionally followed by a hashref of options
754 (C<-excludes> and C<-alias>).
756 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
758 =item B<< Moose::Meta::Class->create_anon_class >>
760 This overrides the parent's method to accept a C<roles> option, just
763 It also accepts a C<cache> option. If this is true, then the anonymous
764 class will be cached based on its superclasses and roles. If an
765 existing anonymous class in the cache has the same superclasses and
766 roles, it will be reused.
768 my $metaclass = Moose::Meta::Class->create_anon_class(
769 superclasses => ['Foo'],
770 roles => [qw/Some Roles Go Here/],
774 Each entry in both the C<superclasses> and the C<roles> option can be
775 followed by a hash reference with arguments. The C<superclasses>
776 option can be supplied with a L<-version|Class::MOP/Class Loading
777 Options> option that ensures the loaded superclass satisfies the
778 required version. The C<role> option also takes the C<-version> as an
779 argument, but the option hash reference can also contain any other
780 role relevant values like exclusions or parameterized role arguments.
782 =item B<< $metaclass->make_immutable(%options) >>
784 This overrides the parent's method to add a few options. Specifically,
785 it uses the Moose-specific constructor and destructor classes, and
786 enables inlining the destructor.
788 Since Moose always inlines attributes, it sets the C<inline_accessors> option
791 =item B<< $metaclass->new_object(%params) >>
793 This overrides the parent's method in order to add support for
796 =item B<< $metaclass->superclasses(@superclasses) >>
798 This is the accessor allowing you to read or change the parents of
801 Each superclass can be followed by a hash reference containing a
802 L<-version|Class::MOP/Class Loading Options> value. If the version
803 requirement is not satisfied an error will be thrown.
805 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
807 This adds an C<override> method modifier to the package.
809 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
811 This adds an C<augment> method modifier to the package.
813 =item B<< $metaclass->calculate_all_roles >>
815 This will return a unique array of C<Moose::Meta::Role> instances
816 which are attached to this class.
818 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
820 This will return a unique array of C<Moose::Meta::Role> instances
821 which are attached to this class, and each of this class's ancestors.
823 =item B<< $metaclass->add_role($role) >>
825 This takes a L<Moose::Meta::Role> object, and adds it to the class's
826 list of roles. This I<does not> actually apply the role to the class.
828 =item B<< $metaclass->role_applications >>
830 Returns a list of L<Moose::Meta::Role::Application::ToClass>
831 objects, which contain the arguments to role application.
833 =item B<< $metaclass->add_role_application($application) >>
835 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
836 adds it to the class's list of role applications. This I<does not>
837 actually apply any role to the class; it is only for tracking role
840 =item B<< $metaclass->does_role($role) >>
842 This returns a boolean indicating whether or not the class does the specified
843 role. The role provided can be either a role name or a L<Moose::Meta::Role>
844 object. This tests both the class and its parents.
846 =item B<< $metaclass->excludes_role($role_name) >>
848 A class excludes a role if it has already composed a role which
849 excludes the named role. This tests both the class and its parents.
851 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
853 This overrides the parent's method in order to allow the parameters to
854 be provided as a hash reference.
856 =item B<< $metaclass->constructor_class($class_name) >>
858 =item B<< $metaclass->destructor_class($class_name) >>
860 These are the names of classes used when making a class immutable. These
861 default to L<Moose::Meta::Method::Constructor> and
862 L<Moose::Meta::Method::Destructor> respectively. These accessors are
863 read-write, so you can use them to change the class name.
865 =item B<< $metaclass->error_class($class_name) >>
867 The name of the class used to throw errors. This defaults to
868 L<Moose::Error::Default>, which generates an error with a stacktrace
869 just like C<Carp::confess>.
871 =item B<< $metaclass->throw_error($message, %extra) >>
873 Throws the error created by C<create_error> using C<raise_error>
879 See L<Moose/BUGS> for details on reporting bugs.