X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=d23de0fc8e13967ea40d105871dc42ca8414cce7;hb=64aa50c4510c74cef91186986744241ebf9fec79;hp=94459f25e6335e97b2c932dafd4d5ea50c0512dc;hpb=e2eef3a55ebd2bcee27681cc63b48b502b3ee812;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 94459f2..d23de0f 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -6,18 +6,22 @@ use warnings; use Class::MOP; -use Carp (); +use Carp qw( confess ); +use Data::OptList; use List::Util qw( first ); -use List::MoreUtils qw( any all uniq ); +use List::MoreUtils qw( any all uniq first_index ); use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.74'; +our $VERSION = '1.04'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overridden; use Moose::Meta::Method::Augmented; use Moose::Error::Default; +use Moose::Meta::Class::Immutable::Trait; +use Moose::Meta::Method::Constructor; +use Moose::Meta::Method::Destructor; use base 'Class::MOP::Class'; @@ -26,6 +30,18 @@ __PACKAGE__->meta->add_attribute('roles' => ( default => sub { [] } )); +__PACKAGE__->meta->add_attribute('role_applications' => ( + reader => '_get_role_applications', + default => sub { [] } +)); + +__PACKAGE__->meta->add_attribute( + Class::MOP::Attribute->new('immutable_trait' => ( + accessor => "immutable_trait", + default => 'Moose::Meta::Class::Immutable::Trait', + )) +); + __PACKAGE__->meta->add_attribute('constructor_class' => ( accessor => 'constructor_class', default => 'Moose::Meta::Method::Constructor', @@ -41,44 +57,46 @@ __PACKAGE__->meta->add_attribute('error_class' => ( default => 'Moose::Error::Default', )); - sub initialize { my $class = shift; my $pkg = shift; - return Class::MOP::get_metaclass_by_name($pkg) + return Class::MOP::get_metaclass_by_name($pkg) || $class->SUPER::initialize($pkg, 'attribute_metaclass' => 'Moose::Meta::Attribute', 'method_metaclass' => 'Moose::Meta::Method', 'instance_metaclass' => 'Moose::Meta::Instance', @_ - ); + ); +} + +sub _immutable_options { + my ( $self, @args ) = @_; + + $self->SUPER::_immutable_options( + inline_destructor => 1, + + # Moose always does this when an attribute is created + inline_accessors => 0, + + @args, + ); } sub create { - my ($self, $package_name, %options) = @_; - + my ($class, $package_name, %options) = @_; + (ref $options{roles} eq 'ARRAY') - || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles}) + || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles}) if exists $options{roles}; my $roles = delete $options{roles}; - my $class = $self->SUPER::create($package_name, %options); + my $new_meta = $class->SUPER::create($package_name, %options); if ($roles) { - Moose::Util::apply_all_roles( $class, @$roles ); + Moose::Util::apply_all_roles( $new_meta, @$roles ); } - - return $class; -} -sub _check_metaclass_compatibility { - my $self = shift; - - if ( my @supers = $self->superclasses ) { - $self->_fix_metaclass_incompatibility(@supers); - } - - $self->SUPER::_check_metaclass_compatibility(@_); + return $new_meta; } my %ANON_CLASSES; @@ -87,17 +105,14 @@ sub create_anon_class { my ($self, %options) = @_; my $cache_ok = delete $options{cache}; - - # something like Super::Class|Super::Class::2=Role|Role::1 - my $cache_key = join '=' => ( - join('|', @{$options{superclasses} || []}), - join('|', sort @{$options{roles} || []}), - ); - + + my $cache_key + = _anon_cache_key( $options{superclasses}, $options{roles} ); + if ($cache_ok && defined $ANON_CLASSES{$cache_key}) { return $ANON_CLASSES{$cache_key}; } - + my $new_class = $self->SUPER::create_anon_class(%options); $ANON_CLASSES{$cache_key} = $new_class @@ -106,6 +121,59 @@ sub create_anon_class { return $new_class; } +sub _anon_cache_key { + # Makes something like Super::Class|Super::Class::2=Role|Role::1 + return join '=' => ( + join( '|', @{ $_[0] || [] } ), + join( '|', sort @{ $_[1] || [] } ), + ); +} + +sub reinitialize { + my $self = shift; + my $pkg = shift; + + my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg); + + my $cache_key; + + my %existing_classes; + if ($meta) { + %existing_classes = map { $_ => $meta->$_() } qw( + attribute_metaclass + method_metaclass + wrapped_method_metaclass + instance_metaclass + constructor_class + destructor_class + error_class + ); + + $cache_key = _anon_cache_key( + [ $meta->superclasses ], + [ map { $_->name } @{ $meta->roles } ], + ) if $meta->is_anon_class; + } + + my $new_meta = $self->SUPER::reinitialize( + $pkg, + %existing_classes, + @_, + ); + + return $new_meta unless defined $cache_key; + + my $new_cache_key = _anon_cache_key( + [ $meta->superclasses ], + [ map { $_->name } @{ $meta->roles } ], + ); + + delete $ANON_CLASSES{$cache_key}; + $ANON_CLASSES{$new_cache_key} = $new_meta; + + return $new_meta; +} + sub add_role { my ($self, $role) = @_; (blessed($role) && $role->isa('Moose::Meta::Role')) @@ -113,12 +181,35 @@ sub add_role { push @{$self->roles} => $role; } +sub role_applications { + my ($self) = @_; + + return @{$self->_get_role_applications}; +} + +sub add_role_application { + my ($self, $application) = @_; + (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass')) + || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application); + push @{$self->_get_role_applications} => $application; +} + sub calculate_all_roles { my $self = shift; my %seen; grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles }; } +sub calculate_all_roles_with_inheritance { + my $self = shift; + my %seen; + grep { !$seen{$_->name}++ } + map { Class::MOP::class_of($_)->can('calculate_all_roles') + ? Class::MOP::class_of($_)->calculate_all_roles + : () } + $self->linearized_isa; +} + sub does_role { my ($self, $role_name) = @_; @@ -160,11 +251,11 @@ sub excludes_role { } sub new_object { - my $class = shift; + my $self = shift; my $params = @_ == 1 ? $_[0] : {@_}; - my $self = $class->SUPER::new_object($params); + my $object = $self->SUPER::new_object($params); - foreach my $attr ( $class->get_all_attributes() ) { + foreach my $attr ( $self->get_all_attributes() ) { next unless $attr->can('has_trigger') && $attr->has_trigger; @@ -175,53 +266,48 @@ sub new_object { next unless exists $params->{$init_arg}; $attr->trigger->( - $self, + $object, ( $attr->should_coerce - ? $attr->get_read_method_ref->($self) + ? $attr->get_read_method_ref->($object) : $params->{$init_arg} ), ); } - return $self; -} + $object->BUILDALL($params) if $object->can('BUILDALL'); -sub _construct_instance { - my $class = shift; - my $params = @_ == 1 ? $_[0] : {@_}; - my $meta_instance = $class->get_meta_instance; - # FIXME: - # the code below is almost certainly incorrect - # but this is foreign inheritance, so we might - # have to kludge it in the end. - my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance(); - foreach my $attr ($class->get_all_attributes()) { - $attr->initialize_instance_slot($meta_instance, $instance, $params); - } - return $instance; + return $object; } sub superclasses { my $self = shift; - my @supers = @_; - foreach my $super (@supers) { - my $meta = Class::MOP::load_class($super); - Moose->throw_error("You cannot inherit from a Moose Role ($super)") + my $supers = Data::OptList::mkopt(\@_); + foreach my $super (@{ $supers }) { + my ($name, $opts) = @{ $super }; + Class::MOP::load_class($name, $opts); + my $meta = Class::MOP::class_of($name); + $self->throw_error("You cannot inherit from a Moose Role ($name)") if $meta && $meta->isa('Moose::Meta::Role') } - return $self->SUPER::superclasses(@supers); + return $self->SUPER::superclasses(map { $_->[0] } @{ $supers }); } ### --------------------------------------------- sub add_attribute { my $self = shift; - $self->SUPER::add_attribute( + my $attr = (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute') - ? $_[0] - : $self->_process_attribute(@_)) - ); + ? $_[0] + : $self->_process_attribute(@_)); + $self->SUPER::add_attribute($attr); + # it may be a Class::MOP::Attribute, theoretically, which doesn't have + # 'bare' and doesn't implement this method + if ($attr->can('_check_associated_methods')) { + $attr->_check_associated_methods; + } + return $attr; } sub add_override_method_modifier { @@ -261,142 +347,27 @@ sub _find_next_method_by_name_which_is_not_overridden { return undef; } -sub _fix_metaclass_incompatibility { - my ($self, @superclasses) = @_; - - foreach my $super (@superclasses) { - next if $self->_superclass_meta_is_compatible($super); - - unless ( $self->is_pristine ) { - $self->throw_error( - "Cannot attempt to reinitialize metaclass for " - . $self->name - . ", it isn't pristine" ); - } +## Metaclass compatibility - $self->_reconcile_with_superclass_meta($super); - } -} - -sub _superclass_meta_is_compatible { - my ($self, $super) = @_; - - my $super_meta = Class::MOP::Class->initialize($super) - or return 1; - - next unless $super_meta->isa("Class::MOP::Class"); - - my $super_meta_name - = $super_meta->is_immutable - ? $super_meta->get_mutable_metaclass_name - : ref($super_meta); - - return 1 - if $self->isa($super_meta_name) - and - $self->instance_metaclass->isa( $super_meta->instance_metaclass ); -} - -# I don't want to have to type this >1 time -my @MetaClassTypes = - qw( attribute_metaclass method_metaclass instance_metaclass - constructor_class destructor_class error_class ); - -sub _reconcile_with_superclass_meta { - my ($self, $super) = @_; - - my $super_meta = Class::MOP::class_of($super); - - my $super_meta_name - = $super_meta->is_immutable - ? $super_meta->get_mutable_metaclass_name - : ref($super_meta); - - my $self_metaclass = ref $self; - - # If neither of these is true we have a more serious - # incompatibility that we just cannot fix (yet?). - if ( $super_meta_name->isa( ref $self ) - && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) { - $self->_reinitialize_with($super_meta); - } - elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) { - $self->_reconcile_role_differences($super_meta); +sub _base_metaclasses { + my $self = shift; + my %metaclasses = $self->SUPER::_base_metaclasses; + for my $class (keys %metaclasses) { + $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/; } -} - -sub _reinitialize_with { - my ( $self, $new_meta ) = @_; - - my $new_self = $new_meta->reinitialize( - $self->name, - attribute_metaclass => $new_meta->attribute_metaclass, - method_metaclass => $new_meta->method_metaclass, - instance_metaclass => $new_meta->instance_metaclass, + return ( + %metaclasses, + error_class => 'Moose::Error::Default', ); - - $new_self->$_( $new_meta->$_ ) - for qw( constructor_class destructor_class error_class ); - - %$self = %$new_self; - - bless $self, ref $new_self; - - # We need to replace the cached metaclass instance or else when it - # goes out of scope Class::MOP::Class destroy's the namespace for - # the metaclass's class, causing much havoc. - Class::MOP::store_metaclass_by_name( $self->name, $self ); - Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class; } -# In the more complex case, we share a common ancestor with our -# superclass's metaclass, but each metaclass (ours and the parent's) -# has a different set of roles applied. We reconcile this by first -# reinitializing into the parent class, and _then_ applying our own -# roles. -sub _all_metaclasses_differ_by_roles_only { - my ($self, $super_meta) = @_; - - for my $pair ( - [ ref $self, ref $super_meta ], - map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes - ) { - - next if $pair->[0] eq $pair->[1]; - - my $self_meta_meta = Class::MOP::Class->initialize( $pair->[0] ); - my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] ); - - my $common_ancestor - = _find_common_ancestor( $self_meta_meta, $super_meta_meta ); - - return unless $common_ancestor; - - return - unless _is_role_only_subclass_of( - $self_meta_meta, - $common_ancestor, - ) - && _is_role_only_subclass_of( - $super_meta_meta, - $common_ancestor, - ); - } - - return 1; -} - -# This, and some other functions, could be called as methods, but -# they're not for two reasons. One, we just end up ignoring the first -# argument, because we can't call these directly on one of the real -# arguments, because one of them could be a Class::MOP::Class object -# and not a Moose::Meta::Class. Second, only a completely insane -# person would attempt to subclass this stuff! -sub _find_common_ancestor { - my ($meta1, $meta2) = @_; +sub _find_common_base { + my $self = shift; + my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_; + return unless defined($meta1) && defined($meta2); # FIXME? This doesn't account for multiple inheritance (not sure - # if it needs to though). For example, is somewhere in $meta1's + # if it needs to though). For example, if somewhere in $meta1's # history it inherits from both ClassA and ClassB, and $meta2 # inherits from ClassB & ClassA, does it matter? And what crazy # fool would do that anyway? @@ -406,37 +377,52 @@ sub _find_common_ancestor { return first { $meta1_parents{$_} } $meta2->linearized_isa; } -sub _is_role_only_subclass_of { - my ($meta, $ancestor) = @_; - - return 1 if $meta->name eq $ancestor; - - my @roles = _all_roles_until( $meta, $ancestor ); - - my %role_packages = map { $_->name => 1 } @roles; - - my $ancestor_meta = Class::MOP::Class->initialize($ancestor); +sub _get_ancestors_until { + my $self = shift; + my ($start_name, $until_name) = @_; - my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa; + my @ancestor_names; + for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) { + last if $ancestor_name eq $until_name; + push @ancestor_names, $ancestor_name; + } + return @ancestor_names; +} - for my $method ( $meta->get_all_methods() ) { +sub _is_role_only_subclass { + my $self = shift; + my ($meta_name) = @_; + my $meta = Class::MOP::Class->initialize($meta_name); + my @parent_names = $meta->superclasses; + + # XXX: don't feel like messing with multiple inheritance here... what would + # that even do? + return unless @parent_names == 1; + my ($parent_name) = @parent_names; + my $parent_meta = Class::MOP::Class->initialize($parent_name); + + # loop over all methods that are a part of the current class + # (not inherited) + for my $method (map { $meta->get_method($_) } $meta->get_method_list) { + # always ignore meta next if $method->name eq 'meta'; - next if $method->can('associated_attribute'); - - next - if $role_packages{ $method->original_package_name } - || $shared_ancestors{ $method->original_package_name }; + # we'll deal with attributes below + next if $method->isa('Class::MOP::Method::Accessor'); + # if the method comes from a role we consumed, ignore it + next if $meta->can('does_role') + && $meta->does_role($method->original_package_name); return 0; } + # loop over all attributes that are a part of the current class + # (not inherited) # FIXME - this really isn't right. Just because an attribute is # defined in a role doesn't mean it isn't _also_ defined in the # subclass. - for my $attr ( $meta->get_all_attributes ) { - next if $shared_ancestors{ $attr->associated_class->name }; - - next if any { $_->has_attribute( $attr->name ) } @roles; + for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) { + next if any { $_->has_attribute($attr->name) } + $meta->calculate_all_roles_with_inheritance; return 0; } @@ -444,61 +430,154 @@ sub _is_role_only_subclass_of { return 1; } -sub _all_roles { - my $meta = shift; +sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation { + my $self = shift; + my ($super_meta) = @_; + + my $super_meta_name = $super_meta->_real_ref_name; + my $common_base_name = $self->_find_common_base(blessed($self), $super_meta_name); + # if they're not both moose metaclasses, and the cmop fixing couldn't + # do anything, there's nothing more we can do + return unless defined($common_base_name); + return unless $common_base_name->isa('Moose::Meta::Class'); + + my @super_meta_name_ancestor_names = $self->_get_ancestors_until($super_meta_name, $common_base_name); + my @class_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($self), $common_base_name); + # we're only dealing with roles here + return unless all { $self->_is_role_only_subclass($_) } + (@super_meta_name_ancestor_names, + @class_meta_name_ancestor_names); - return _all_roles_until($meta); + return 1; } -sub _all_roles_until { - my ($meta, $stop_at_class) = @_; - - return unless $meta->can('calculate_all_roles'); - - my @roles = $meta->calculate_all_roles; - - for my $class ( $meta->linearized_isa ) { - last if $stop_at_class && $stop_at_class eq $class; +sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation { + my $self = shift; + my ($metaclass_type, $super_meta) = @_; + + my $class_specific_meta_name = $self->$metaclass_type; + return unless $super_meta->can($metaclass_type); + my $super_specific_meta_name = $super_meta->$metaclass_type; + my %metaclasses = $self->_base_metaclasses; + + my $common_base_name = $self->_find_common_base($class_specific_meta_name, $super_specific_meta_name); + # if they're not both moose metaclasses, and the cmop fixing couldn't + # do anything, there's nothing more we can do + return unless defined($common_base_name); + return unless $common_base_name->isa($metaclasses{$metaclass_type}); + + my @super_specific_meta_name_ancestor_names = $self->_get_ancestors_until($super_specific_meta_name, $common_base_name); + my @class_specific_meta_name_ancestor_names = $self->_get_ancestors_until($class_specific_meta_name, $common_base_name); + # we're only dealing with roles here + return unless all { $self->_is_role_only_subclass($_) } + (@super_specific_meta_name_ancestor_names, + @class_specific_meta_name_ancestor_names); - my $meta = Class::MOP::Class->initialize($class); - last unless $meta->can('calculate_all_roles'); + return 1; +} - push @roles, $meta->calculate_all_roles; +sub _role_differences { + my $self = shift; + my ($class_meta_name, $super_meta_name) = @_; + my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance') + ? $super_meta_name->meta->calculate_all_roles_with_inheritance + : (); + my @role_metas = $class_meta_name->meta->can('calculate_all_roles_with_inheritance') + ? $class_meta_name->meta->calculate_all_roles_with_inheritance + : (); + my @differences; + for my $role_meta (@role_metas) { + push @differences, $role_meta + unless any { $_->name eq $role_meta->name } @super_role_metas; } - - return uniq @roles; + return @differences; } -sub _reconcile_role_differences { - my ($self, $super_meta) = @_; +sub _reconcile_roles_for_metaclass { + my $self = shift; + my ($class_meta_name, $super_meta_name) = @_; + + my @role_differences = $self->_role_differences( + $class_meta_name, $super_meta_name, + ); + return Moose::Meta::Class->create_anon_class( + superclasses => [$super_meta_name], + roles => \@role_differences, + cache => 1, + ); +} - my $self_meta = Class::MOP::class_of($self); +sub _can_fix_metaclass_incompatibility_by_role_reconciliation { + my $self = shift; + my ($super_meta) = @_; - my %roles; + return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta); - if ( my @roles = map { $_->name } _all_roles($self_meta) ) { - $roles{metaclass_roles} = \@roles; + my %base_metaclass = $self->_base_metaclasses; + for my $metaclass_type (keys %base_metaclass) { + next unless defined $self->$metaclass_type; + return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta); } - for my $thing (@MetaClassTypes) { - my $name = $self->$thing(); - - my $thing_meta = Class::MOP::Class->initialize($name); + return; +} - my @roles = map { $_->name } _all_roles($thing_meta) - or next; +sub _can_fix_metaclass_incompatibility { + my $self = shift; + return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_); + return $self->SUPER::_can_fix_metaclass_incompatibility(@_); +} - $roles{ $thing . '_roles' } = \@roles; +sub _fix_class_metaclass_incompatibility { + my $self = shift; + my ($super_meta) = @_; + + $self->SUPER::_fix_class_metaclass_incompatibility(@_); + + if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) { + ($self->is_pristine) + || confess "Can't fix metaclass incompatibility for " + . $self->name + . " because it is not pristine."; + my $super_meta_name = $super_meta->_real_ref_name; + my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name); + my $new_self = $class_meta_subclass_meta->name->reinitialize( + $self->name, + ); + %$self = %$new_self; + bless $self, $class_meta_subclass_meta->name; + # We need to replace the cached metaclass instance or else when it + # goes out of scope Class::MOP::Class destroy's the namespace for + # the metaclass's class, causing much havoc. + Class::MOP::store_metaclass_by_name( $self->name, $self ); + Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class; } +} - $self->_reinitialize_with($super_meta); - - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $self->name, - %roles, - ); - - return $self; +sub _fix_single_metaclass_incompatibility { + my $self = shift; + my ($metaclass_type, $super_meta) = @_; + + $self->SUPER::_fix_single_metaclass_incompatibility(@_); + + if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) { + ($self->is_pristine) + || confess "Can't fix metaclass incompatibility for " + . $self->name + . " because it is not pristine."; + my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type); + my $new_self = $super_meta->reinitialize( + $self->name, + $metaclass_type => $class_specific_meta_subclass_meta->name, + ); + %$self = %$new_self; + bless $self, blessed($super_meta); + # We need to replace the cached metaclass instance or else when it + # goes out of scope Class::MOP::Class destroy's the namespace for + # the metaclass's class, causing much havoc. + Class::MOP::store_metaclass_by_name( $self->name, $self ); + Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class; + } } sub _process_attribute { @@ -537,36 +616,6 @@ sub _process_inherited_attribute { ## ------------------------------------------------- -use Moose::Meta::Method::Constructor; -use Moose::Meta::Method::Destructor; - - -sub _default_immutable_transformer_options { - my $self = shift; - - my %options = $self->SUPER::_default_immutable_transformer_options; - - # We need to copy the references as we do not want to alter the - # superclass's references. - $options{cannot_call} = [ @{ $options{cannot_call} }, 'add_role' ]; - $options{memoize} = { - %{ $options{memoize} }, - calculate_all_roles => 'ARRAY', - }; - - %options = ( - %options, - constructor_class => $self->constructor_class, - destructor_class => $self->destructor_class, - inline_destructor => 1, - - # Moose always does this when an attribute is created - inline_accessors => 0, - ); - - return %options -} - our $error_level; sub throw_error { @@ -644,8 +693,9 @@ These all default to the appropriate Moose class. =item B<< Moose::Meta::Class->create($package_name, %options) >> This overrides the parent's method in order to accept a C -option. This should be an array reference containing one more roles -that the class does. +option. This should be an array reference containing roles +that the class does, each optionally followed by a hashref of options +(C<-excludes> and C<-alias>). my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] ); @@ -665,6 +715,14 @@ roles, it will be reused. cache => 1, ); +Each entry in both the C and the C option can be +followed by a hash reference with arguments. The C +option can be supplied with a L<-version|Class::MOP/Class Loading +Options> option that ensures the loaded superclass satisfies the +required version. The C option also takes the C<-version> as an +argument, but the option hash reference can also contain any other +role relevant values like exclusions or parameterized role arguments. + =item B<< $metaclass->make_immutable(%options) >> This overrides the parent's method to add a few options. Specifically, @@ -679,6 +737,15 @@ C option to false. This overrides the parent's method in order to add support for attribute triggers. +=item B<< $metaclass->superclasses(@superclasses) >> + +This is the accessor allowing you to read or change the parents of +the class. + +Each superclass can be followed by a hash reference containing a +L<-version|Class::MOP/Class Loading Options> value. If the version +requirement is not satisfied an error will be thrown. + =item B<< $metaclass->add_override_method_modifier($name, $sub) >> This adds an C method modifier to the package. @@ -692,15 +759,33 @@ This adds an C method modifier to the package. This will return a unique array of C instances which are attached to this class. +=item B<< $metaclass->calculate_all_roles_with_inheritance >> + +This will return a unique array of C instances +which are attached to this class, and each of this class's ancestors. + =item B<< $metaclass->add_role($role) >> This takes a L object, and adds it to the class's list of roles. This I actually apply the role to the class. -=item B<< $metaclass->does_role($role_name) >> +=item B<< $metaclass->role_applications >> + +Returns a list of L +objects, which contain the arguments to role application. + +=item B<< $metaclass->add_role_application($application) >> + +This takes a L object, and +adds it to the class's list of role applications. This I +actually apply any role to the class; it is only for tracking role +applications. + +=item B<< $metaclass->does_role($role) >> -This returns a boolean indicating whether or not the class does the -specified role. This tests both the class and its parents. +This returns a boolean indicating whether or not the class does the specified +role. The role provided can be either a role name or a L +object. This tests both the class and its parents. =item B<< $metaclass->excludes_role($role_name) >> @@ -712,9 +797,9 @@ excludes the named role. This tests both the class and its parents. This overrides the parent's method in order to allow the parameters to be provided as a hash reference. -=item B<< $metaclass->constructor_class ($class_name) >> +=item B<< $metaclass->constructor_class($class_name) >> -=item B<< $metaclass->destructor_class ($class_name) >> +=item B<< $metaclass->destructor_class($class_name) >> These are the names of classes used when making a class immutable. These default to L and @@ -735,9 +820,7 @@ Throws the error created by C using C =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR @@ -745,7 +828,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L