Version 1.05
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
index 4ab875c..1b8b875 100644 (file)
@@ -6,12 +6,13 @@ 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 first_index );
 use Scalar::Util 'weaken', 'blessed';
 
-our $VERSION   = '0.89_01';
+our $VERSION   = '1.05';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -82,30 +83,20 @@ sub _immutable_options {
 }
 
 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;
@@ -115,11 +106,8 @@ sub create_anon_class {
 
     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};
@@ -133,39 +121,64 @@ sub create_anon_class {
     return $new_class;
 }
 
-sub add_role {
-    my ($self, $role) = @_;
-    (blessed($role) && $role->isa('Moose::Meta::Role'))
-        || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
-    push @{$self->roles} => $role;
+sub _anon_cache_key {
+    # Makes something like Super::Class|Super::Class::2=Role|Role::1
+    return join '=' => (
+        join( '|', @{ $_[0]      || [] } ),
+        join( '|', sort @{ $_[1] || [] } ),
+    );
 }
 
-sub make_immutable {
+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
+        );
 
-    # we do this for metaclasses way too often to do this check for them
-    if ( !$self->name->isa('Class::MOP::Object') ) {
-        my @superclasses = grep { $_ ne 'Moose::Object' && $_ ne $self->name }
-            $self->linearized_isa;
-
-        for my $superclass (@superclasses) {
-            my $meta = Class::MOP::class_of($superclass);
-
-            next unless $meta && $meta->isa('Moose::Meta::Class');
-            next unless $meta->is_mutable;
-            # This can happen when a base class role is applied via
-            # Moose::Util::MetaRole::apply_base_class_roles. The parent is an
-            # anon class and is still mutable, but that's okay.
-            next if $meta->is_anon_class;
-
-            Carp::cluck( "Calling make_immutable on "
-                    . $self->name
-                    . ", which has a mutable ancestor ($superclass)" );
-            last;
-        }
+        $cache_key = _anon_cache_key(
+            [ $meta->superclasses ],
+            [ map { $_->name } @{ $meta->roles } ],
+        ) if $meta->is_anon_class;
     }
 
-    $self->SUPER::make_immutable(@_);
+    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'))
+        || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
+    push @{$self->roles} => $role;
 }
 
 sub role_applications {
@@ -187,6 +200,16 @@ sub calculate_all_roles {
     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) = @_;
 
@@ -228,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;
 
@@ -243,28 +266,31 @@ 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');
+
+    return $object;
 }
 
 sub superclasses {
     my $self = shift;
-    my @supers = @_;
-    foreach my $super (@supers) {
-        Class::MOP::load_class($super);
-        my $meta = Class::MOP::class_of($super);
-        $self->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 });
 }
 
 ### ---------------------------------------------
@@ -321,168 +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) {
-        my $meta = Class::MOP::Class->initialize($super);
-
-        my @all_supers = $meta->linearized_isa;
-        shift @all_supers;
+## Metaclass compatibility
 
-        my @super_metas_to_fix = ($meta);
-
-        # We need to check & fix the immediate superclass. If its @ISA
-        # contains a class without a metaclass instance, followed by a
-        # class _with_ a metaclass instance, init a metaclass instance
-        # for classes without one and fix compat up to and including
-        # the class which was already initialized.
-        my $idx = first_index { Class::MOP::class_of($_) } @all_supers;
-
-        push @super_metas_to_fix,
-            map { Class::MOP::Class->initialize($_) } @all_supers[ 0 .. $idx ]
-            if $idx >= 0;
-
-        foreach my $super_meta (@super_metas_to_fix) {
-            $self->_fix_one_incompatible_metaclass($super_meta);
-        }
-    }
-}
-
-sub _fix_one_incompatible_metaclass {
-    my ($self, $meta) = @_;
-
-    return if $self->_superclass_meta_is_compatible($meta);
-
-    unless ( $self->is_pristine ) {
-        $self->throw_error(
-              "Cannot attempt to reinitialize metaclass for "
-            . $self->name
-            . ", it isn't pristine" );
-    }
-
-    $self->_reconcile_with_superclass_meta($meta);
-}
-
-sub _superclass_meta_is_compatible {
-    my ($self, $super_meta) = @_;
-
-    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
-        wrapped_method_metaclass
-        instance_metaclass
-        constructor_class
-        destructor_class
-        error_class );
-
-sub _reconcile_with_superclass_meta {
-    my ($self, $super_meta) = @_;
-
-    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?
@@ -492,37 +377,67 @@ 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);
+
+    my @roles = $meta->can('calculate_all_roles_with_inheritance')
+                    ? $meta->calculate_all_roles_with_inheritance
+                    : ();
+
+    # 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';
+        # we'll deal with attributes below
         next if $method->can('associated_attribute');
-
-        next
-            if $role_packages{ $method->original_package_name }
-                || $shared_ancestors{ $method->original_package_name };
+        # if the method comes from a role we consumed, ignore it
+        next if $meta->can('does_role')
+             && $meta->does_role($method->original_package_name);
+        # FIXME - this really isn't right. Just because a modifier is
+        # defined in a role doesn't mean it isn't _also_ defined in the
+        # subclass.
+        next if $method->isa('Class::MOP::Method::Wrapped')
+             && (
+                 (!scalar($method->around_modifiers)
+               || any { $_->has_around_method_modifiers($method->name) } @roles)
+              && (!scalar($method->before_modifiers)
+               || any { $_->has_before_method_modifiers($method->name) } @roles)
+              && (!scalar($method->after_modifiers)
+               || any { $_->has_after_method_modifiers($method->name) } @roles)
+                );
 
         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) } @roles;
 
         return 0;
     }
@@ -530,61 +445,169 @@ 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;
 
-    return _all_roles_until($meta);
+    return $self->_classes_differ_by_roles_only(
+        blessed($self),
+        $super_meta_name,
+        'Moose::Meta::Class',
+    );
 }
 
-sub _all_roles_until {
-    my ($meta, $stop_at_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;
+
+    return $self->_classes_differ_by_roles_only(
+        $class_specific_meta_name,
+        $super_specific_meta_name,
+        $metaclasses{$metaclass_type},
+    );
+}
+
+sub _classes_differ_by_roles_only {
+    my $self = shift;
+    my ( $self_meta_name, $super_meta_name, $expected_ancestor ) = @_;
 
-    return unless $meta->can('calculate_all_roles');
+    my $common_base_name
+        = $self->_find_common_base( $self_meta_name, $super_meta_name );
 
-    my @roles = $meta->calculate_all_roles;
+    # If they're not both moose metaclasses, and the cmop fixing couldn't do
+    # anything, there's nothing more we can do. The $expected_ancestor should
+    # always be a Moose metaclass name like Moose::Meta::Class or
+    # Moose::Meta::Attribute.
+    return unless defined $common_base_name;
+    return unless $common_base_name->isa($expected_ancestor);
 
-    for my $class ( $meta->linearized_isa ) {
-        last if $stop_at_class && $stop_at_class eq $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( $self_meta_name, $common_base_name );
 
-        my $meta = Class::MOP::Class->initialize($class);
-        last unless $meta->can('calculate_all_roles');
+    return
+        unless all { $self->_is_role_only_subclass($_) }
+        @super_meta_name_ancestor_names,
+        @class_meta_name_ancestor_names;
 
-        push @roles, $meta->calculate_all_roles;
-    }
+    return 1;
+}
 
-    return uniq @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 @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 $self_meta = Class::MOP::class_of($self);
+    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 %roles;
+sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
+    my $self = shift;
+    my ($super_meta) = @_;
 
-    if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
-        $roles{metaclass_roles} = \@roles;
+    return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
+
+    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();
+    return;
+}
+
+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(@_);
+}
+
+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,
+        );
 
-        my $thing_meta = Class::MOP::Class->initialize($name);
+        $self->_replace_self( $new_self, $class_meta_subclass_meta->name );
+    }
+}
 
-        my @roles = map { $_->name } _all_roles($thing_meta)
-            or next;
+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,
+        );
 
-        $roles{ $thing . '_roles' } = \@roles;
+        $self->_replace_self( $new_self, blessed($super_meta) );
     }
+}
 
-    $self->_reinitialize_with($super_meta);
 
-    Moose::Util::MetaRole::apply_metaclass_roles(
-        for_class => $self->name,
-        %roles,
-    );
+sub _replace_self {
+    my $self      = shift;
+    my ( $new_self, $new_class)   = @_;
+
+    %$self = %$new_self;
+    bless $self, $new_class;
 
-    return $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;
 }
 
 sub _process_attribute {
@@ -722,6 +745,14 @@ roles, it will be reused.
       cache        => 1,
   );
 
+Each entry in both the C<superclasses> and the C<roles> option can be
+followed by a hash reference with arguments. The C<superclasses>
+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<role> 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,
@@ -736,6 +767,15 @@ C<inline_accessors> 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<override> method modifier to the package.
@@ -749,6 +789,11 @@ This adds an C<augment> method modifier to the package.
 This will return a unique array of C<Moose::Meta::Role> instances
 which are attached to this class.
 
+=item B<< $metaclass->calculate_all_roles_with_inheritance >>
+
+This will return a unique array of C<Moose::Meta::Role> instances
+which are attached to this class, and each of this class's ancestors.
+
 =item B<< $metaclass->add_role($role) >>
 
 This takes a L<Moose::Meta::Role> object, and adds it to the class's
@@ -766,10 +811,11 @@ adds it to the class's list of role applications. This I<does not>
 actually apply any role to the class; it is only for tracking role
 applications.
 
-=item B<< $metaclass->does_role($role_name) >>
+=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<Moose::Meta::Role>
+object. This tests both the class and its parents.
 
 =item B<< $metaclass->excludes_role($role_name) >>
 
@@ -781,9 +827,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<Moose::Meta::Method::Constructor> and
@@ -804,9 +850,7 @@ Throws the error created by C<create_error> using C<raise_error>
 
 =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<Moose/BUGS> for details on reporting bugs.
 
 =head1 AUTHOR
 
@@ -814,7 +858,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>