Beginning of dzilization
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
index a5e8da7..ae67045 100644 (file)
@@ -6,13 +6,12 @@ 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.96';
-$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overridden;
@@ -21,9 +20,14 @@ use Moose::Error::Default;
 use Moose::Meta::Class::Immutable::Trait;
 use Moose::Meta::Method::Constructor;
 use Moose::Meta::Method::Destructor;
+use Moose::Meta::Method::Meta;
+use Moose::Util;
+use Class::MOP::MiniTrait;
 
 use base 'Class::MOP::Class';
 
+Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
+
 __PACKAGE__->meta->add_attribute('roles' => (
     reader  => 'roles',
     default => sub { [] }
@@ -68,70 +72,21 @@ sub initialize {
             );
 }
 
-sub reinitialize {
-    my $self = shift;
-    my $pkg  = shift;
-
-    my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
-
-    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
-        );
-    }
-
-    return $self->SUPER::reinitialize(
-        $pkg,
-        %existing_classes,
-        @_,
-    );
-}
-
-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 );
-    }
-
-    return $class;
-}
-
-sub _check_metaclass_compatibility {
-    my $self = shift;
-
-    if ( my @supers = $self->superclasses ) {
-        $self->_fix_metaclass_incompatibility(@supers);
+        Moose::Util::apply_all_roles( $new_meta, @$roles );
     }
 
-    $self->SUPER::_check_metaclass_compatibility(@_);
+    return $new_meta;
 }
 
 my %ANON_CLASSES;
@@ -141,24 +96,82 @@ 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};
     }
 
+    $options{weaken} = !$cache_ok
+        unless exists $options{weaken};
+
     my $new_class = $self->SUPER::create_anon_class(%options);
 
-    $ANON_CLASSES{$cache_key} = $new_class
-        if $cache_ok;
+    if ($cache_ok) {
+        $ANON_CLASSES{$cache_key} = $new_class;
+        weaken($ANON_CLASSES{$cache_key});
+    }
 
     return $new_class;
 }
 
+sub _meta_method_class { 'Moose::Meta::Method::Meta' }
+
+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;
+    weaken($ANON_CLASSES{$new_cache_key});
+
+    return $new_meta;
+}
+
 sub add_role {
     my ($self, $role) = @_;
     (blessed($role) && $role->isa('Moose::Meta::Role'))
@@ -185,6 +198,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) = @_;
 
@@ -226,11 +249,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;
 
@@ -241,28 +264,215 @@ 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 _generate_fallback_constructor {
+    my $self = shift;
+    my ($class) = @_;
+    return $class . '->Moose::Object::new(@_)'
+}
+
+sub _inline_params {
+    my $self = shift;
+    my ($params, $class) = @_;
+    return (
+        'my ' . $params . ' = ',
+        $self->_inline_BUILDARGS($class, '@_'),
+        ';',
+    );
+}
+
+sub _inline_BUILDARGS {
+    my $self = shift;
+    my ($class, $args) = @_;
+
+    my $buildargs = $self->find_method_by_name("BUILDARGS");
+
+    if ($args eq '@_'
+     && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
+        return (
+            'do {',
+                'my $params;',
+                'if (scalar @_ == 1) {',
+                    'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
+                        $self->_inline_throw_error(
+                            '"Single parameters to new() must be a HASH ref"',
+                            'data => $_[0]',
+                        ) . ';',
+                    '}',
+                    '$params = { %{ $_[0] } };',
+                '}',
+                'elsif (@_ % 2) {',
+                    'Carp::carp(',
+                        '"The new() method for ' . $class . ' expects a '
+                      . 'hash reference or a key/value list. You passed an '
+                      . 'odd number of arguments"',
+                    ');',
+                    '$params = {@_, undef};',
+                '}',
+                'else {',
+                    '$params = {@_};',
+                '}',
+                '$params;',
+            '}',
+        );
+    }
+    else {
+        return $class . '->BUILDARGS(' . $args . ')';
+    }
+}
+
+sub _inline_slot_initializer {
+    my $self  = shift;
+    my ($attr, $idx) = @_;
+
+    return (
+        '## ' . $attr->name,
+        $self->_inline_check_required_attr($attr),
+        $self->SUPER::_inline_slot_initializer(@_),
+    );
+}
+
+sub _inline_check_required_attr {
+    my $self = shift;
+    my ($attr) = @_;
+
+    return unless defined $attr->init_arg;
+    return unless $attr->can('is_required') && $attr->is_required;
+    return if $attr->has_default || $attr->has_builder;
+
+    return (
+        'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
+            $self->_inline_throw_error(
+                '"Attribute (' . quotemeta($attr->name) . ') is required"'
+            ) . ';',
+        '}',
+    );
+}
+
+# XXX: these two are duplicated from cmop, because we have to pass the tc stuff
+# through to _inline_set_value - this should probably be fixed, but i'm not
+# quite sure how. -doy
+sub _inline_init_attr_from_constructor {
+    my $self = shift;
+    my ($attr, $idx) = @_;
+
+    my @initial_value = $attr->_inline_set_value(
+        '$instance',
+        '$params->{\'' . $attr->init_arg . '\'}',
+        '$type_constraint_bodies[' . $idx . ']',
+        '$type_constraints[' . $idx . ']',
+        'for constructor',
+    );
+
+    push @initial_value, (
+        '$attrs->[' . $idx . ']->set_initial_value(',
+            '$instance,',
+            $attr->_inline_instance_get('$instance'),
+        ');',
+    ) if $attr->has_initializer;
+
+    return @initial_value;
+}
+
+sub _inline_init_attr_from_default {
+    my $self = shift;
+    my ($attr, $idx) = @_;
+
+    my $default = $self->_inline_default_value($attr, $idx);
+    return unless $default;
+
+    my @initial_value = (
+        'my $default = ' . $default . ';',
+        $attr->_inline_set_value(
+            '$instance',
+            '$default',
+            '$type_constraint_bodies[' . $idx . ']',
+            '$type_constraints[' . $idx . ']',
+            'for constructor',
+        ),
+    );
+
+    push @initial_value, (
+        '$attrs->[' . $idx . ']->set_initial_value(',
+            '$instance,',
+            $attr->_inline_instance_get('$instance'),
+        ');',
+    ) if $attr->has_initializer;
+
+    return @initial_value;
+}
+
+sub _inline_extra_init {
+    my $self = shift;
+    return (
+        $self->_inline_triggers,
+        $self->_inline_BUILDALL,
+    );
+}
+
+sub _inline_triggers {
+    my $self = shift;
+    my @trigger_calls;
+
+    my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
+    for my $i (0 .. $#attrs) {
+        my $attr = $attrs[$i];
+
+        next unless $attr->can('has_trigger') && $attr->has_trigger;
+
+        my $init_arg = $attr->init_arg;
+        next unless defined $init_arg;
+
+        push @trigger_calls,
+            'if (exists $params->{\'' . $init_arg . '\'}) {',
+                '$attrs->[' . $i . ']->trigger->(',
+                    '$instance,',
+                    $attr->_inline_instance_get('$instance') . ',',
+                ');',
+            '}';
+    }
+
+    return @trigger_calls;
+}
+
+sub _inline_BUILDALL {
+    my $self = shift;
+
+    my @methods = reverse $self->find_all_methods_by_name('BUILD');
+    my @BUILD_calls;
+
+    foreach my $method (@methods) {
+        push @BUILD_calls,
+            '$instance->' . $method->{class} . '::BUILD($params);';
+    }
+
+    return @BUILD_calls;
 }
 
 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 });
 }
 
 ### ---------------------------------------------
@@ -319,249 +529,76 @@ sub _find_next_method_by_name_which_is_not_overridden {
     return undef;
 }
 
-sub _fix_metaclass_incompatibility {
-    my ($self, @superclasses) = @_;
-
-    $self->_fix_one_incompatible_metaclass($_)
-        for map { Moose::Meta::Class->initialize($_) } @superclasses;
-}
-
-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;
+## Metaclass compatibility
 
-    # 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) = @_;
-
-    # FIXME? This doesn't account for multiple inheritance (not sure
-    # if it needs to though). For example, is 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?
-
-    my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
-
-    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);
-
-    my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa;
-
-    for my $method ( $meta->get_all_methods() ) {
-        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 };
-
-        return 0;
-    }
-
-    # 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;
+sub _fix_class_metaclass_incompatibility {
+    my $self = shift;
+    my ($super_meta) = @_;
+
+    $self->SUPER::_fix_class_metaclass_incompatibility(@_);
+
+    if ($self->_class_metaclass_can_be_made_compatible($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_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
+        my $new_self = $class_meta_subclass_meta_name->reinitialize(
+            $self->name,
+        );
 
-        return 0;
+        $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
     }
-
-    return 1;
-}
-
-sub _all_roles {
-    my $meta = shift;
-
-    return _all_roles_until($meta);
 }
 
-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;
-
-        my $meta = Class::MOP::Class->initialize($class);
-        last unless $meta->can('calculate_all_roles');
+sub _fix_single_metaclass_incompatibility {
+    my $self = shift;
+    my ($metaclass_type, $super_meta) = @_;
+
+    $self->SUPER::_fix_single_metaclass_incompatibility(@_);
+
+    if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
+        ($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_specific_meta_subclass_meta_name = Moose::Util::_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,
+        );
 
-        push @roles, $meta->calculate_all_roles;
+        $self->_replace_self( $new_self, $super_meta_name );
     }
-
-    return uniq @roles;
 }
 
-sub _reconcile_role_differences {
-    my ($self, $super_meta) = @_;
-
-    my $self_meta = Class::MOP::class_of($self);
-
-    my %roles;
-
-    if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
-        $roles{metaclass_roles} = \@roles;
-    }
-
-    for my $thing (@MetaClassTypes) {
-        my $name = $self->$thing();
+sub _replace_self {
+    my $self      = shift;
+    my ( $new_self, $new_class)   = @_;
 
-        my $thing_meta = Class::MOP::Class->initialize($name);
-
-        my @roles = map { $_->name } _all_roles($thing_meta)
-            or next;
-
-        $roles{ $thing . '_roles' } = \@roles;
-    }
-
-    $self->_reinitialize_with($super_meta);
-
-    Moose::Util::MetaRole::apply_metaclass_roles(
-        for_class => $self->name,
-        %roles,
-    );
+    %$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.
+    my $weaken = Class::MOP::metaclass_is_weak( $self->name );
+    Class::MOP::store_metaclass_by_name( $self->name, $self );
+    Class::MOP::weaken_metaclass( $self->name ) if $weaken;
 }
 
 sub _process_attribute {
@@ -598,6 +635,21 @@ sub _process_inherited_attribute {
     }
 }
 
+## Immutability
+
+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,
+    );
+}
+
 ## -------------------------------------------------
 
 our $error_level;
@@ -608,6 +660,11 @@ sub throw_error {
     $self->raise_error($self->create_error(@args));
 }
 
+sub _inline_throw_error {
+    my ( $self, $msg, $args ) = @_;
+    "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
+}
+
 sub raise_error {
     my ( $self, @args ) = @_;
     die @args;
@@ -640,14 +697,12 @@ sub create_error {
 
 1;
 
+# ABSTRACT: The Moose metaclass
+
 __END__
 
 =pod
 
-=head1 NAME
-
-Moose::Meta::Class - The Moose metaclass
-
 =head1 DESCRIPTION
 
 This class is a subclass of L<Class::MOP::Class> that provides
@@ -699,20 +754,37 @@ 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,
 it uses the Moose-specific constructor and destructor classes, and
 enables inlining the destructor.
 
-Also, since Moose always inlines attributes, it sets the
-C<inline_accessors> option to false.
+Since Moose always inlines attributes, it sets the C<inline_accessors> option
+to false.
 
 =item B<< $metaclass->new_object(%params) >>
 
 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.
@@ -726,6 +798,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
@@ -759,12 +836,12 @@ 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
+These are the names of classes used when making a class immutable. These
+default to L<Moose::Meta::Method::Constructor> and
 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 read-write, so you can use them to change the class name.
 
@@ -784,18 +861,5 @@ Throws the error created by C<create_error> using C<raise_error>
 
 See L<Moose/BUGS> for details on reporting bugs.
 
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
 =cut