javonet-nodejs-sdk 2.4.10 → 2.4.11

package/Binaries/Perl/MacOs/X64/deps/lib/perl5/darwin-thread-multi-2level/Class/MOP/Class.pm

@@ -1,2312 +0,0 @@
-package Class::MOP::Class;
-our $VERSION = '2.2207';
-
-use strict;
-use warnings;
-
-use Class::MOP::Instance;
-use Class::MOP::Method::Wrapped;
-use Class::MOP::Method::Accessor;
-use Class::MOP::Method::Constructor;
-use Class::MOP::MiniTrait;
-
-use Carp 'confess';
-use Module::Runtime 'use_package_optimistically';
-use Scalar::Util 'blessed';
-use Sub::Util 1.40 'set_subname';
-use Try::Tiny;
-use List::Util 1.33 'all';
-
-use parent 'Class::MOP::Module',
-         'Class::MOP::Mixin::HasAttributes',
-         'Class::MOP::Mixin::HasMethods',
-         'Class::MOP::Mixin::HasOverloads';
-
-# Creation
-
-sub initialize {
-    my $class = shift;
-
-    my $package_name;
-
-    if ( @_ % 2 ) {
-        $package_name = shift;
-    } else {
-        my %options = @_;
-        $package_name = $options{package};
-    }
-
-    ($package_name && !ref($package_name))
-        || ($class||__PACKAGE__)->_throw_exception( InitializeTakesUnBlessedPackageName => package_name => $package_name );
-    return Class::MOP::get_metaclass_by_name($package_name)
-        || $class->_construct_class_instance(package => $package_name, @_);
-}
-
-sub reinitialize {
-    my ( $class, @args ) = @_;
-    unshift @args, "package" if @args % 2;
-    my %options = @args;
-    my $old_metaclass = blessed($options{package})
-        ? $options{package}
-        : Class::MOP::get_metaclass_by_name($options{package});
-    $options{weaken} = Class::MOP::metaclass_is_weak($old_metaclass->name)
-        if !exists $options{weaken}
-        && blessed($old_metaclass)
-        && $old_metaclass->isa('Class::MOP::Class');
-    $old_metaclass->_remove_generated_metaobjects
-        if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
-    my $new_metaclass = $class->SUPER::reinitialize(%options);
-    $new_metaclass->_restore_metaobjects_from($old_metaclass)
-        if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
-    return $new_metaclass;
-}
-
-# NOTE: (meta-circularity)
-# this is a special form of _construct_instance
-# (see below), which is used to construct class
-# meta-object instances for any Class::MOP::*
-# class. All other classes will use the more
-# normal &construct_instance.
-sub _construct_class_instance {
-    my $class        = shift;
-    my $options      = @_ == 1 ? $_[0] : {@_};
-    my $package_name = $options->{package};
-    (defined $package_name && $package_name)
-        || $class->_throw_exception("ConstructClassInstanceTakesPackageName");
-    # NOTE:
-    # return the metaclass if we have it cached,
-    # and it is still defined (it has not been
-    # reaped by DESTROY yet, which can happen
-    # annoyingly enough during global destruction)
-
-    if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
-        return $meta;
-    }
-
-    $class
-        = ref $class
-        ? $class->_real_ref_name
-        : $class;
-
-    # now create the metaclass
-    my $meta;
-    if ($class eq 'Class::MOP::Class') {
-        $meta = $class->_new($options);
-    }
-    else {
-        # NOTE:
-        # it is safe to use meta here because
-        # class will always be a subclass of
-        # Class::MOP::Class, which defines meta
-        $meta = $class->meta->_construct_instance($options)
-    }
-
-    # and check the metaclass compatibility
-    $meta->_check_metaclass_compatibility();
-
-    Class::MOP::store_metaclass_by_name($package_name, $meta);
-
-    # NOTE:
-    # we need to weaken any anon classes
-    # so that they can call DESTROY properly
-    Class::MOP::weaken_metaclass($package_name) if $options->{weaken};
-
-    $meta;
-}
-
-sub _real_ref_name {
-    my $self = shift;
-
-    # NOTE: we need to deal with the possibility of class immutability here,
-    # and then get the name of the class appropriately
-    return $self->is_immutable
-        ? $self->_get_mutable_metaclass_name()
-        : ref $self;
-}
-
-sub _new {
-    my $class = shift;
-
-    return Class::MOP::Class->initialize($class)->new_object(@_)
-        if $class ne __PACKAGE__;
-
-    my $options = @_ == 1 ? $_[0] : {@_};
-
-    return bless {
-        # inherited from Class::MOP::Package
-        'package' => $options->{package},
-
-        # NOTE:
-        # since the following attributes will
-        # actually be loaded from the symbol
-        # table, and actually bypass the instance
-        # entirely, we can just leave these things
-        # listed here for reference, because they
-        # should not actually have a value associated
-        # with the slot.
-        'namespace' => \undef,
-        'methods'   => {},
-
-        # inherited from Class::MOP::Module
-        'version'   => \undef,
-        'authority' => \undef,
-
-        # defined in Class::MOP::Class
-        'superclasses' => \undef,
-
-        'attributes' => {},
-        'attribute_metaclass' =>
-            ( $options->{'attribute_metaclass'} || 'Class::MOP::Attribute' ),
-        'method_metaclass' =>
-            ( $options->{'method_metaclass'} || 'Class::MOP::Method' ),
-        'wrapped_method_metaclass' => (
-            $options->{'wrapped_method_metaclass'}
-                || 'Class::MOP::Method::Wrapped'
-        ),
-        'instance_metaclass' =>
-            ( $options->{'instance_metaclass'} || 'Class::MOP::Instance' ),
-        'immutable_trait' => (
-            $options->{'immutable_trait'}
-                || 'Class::MOP::Class::Immutable::Trait'
-        ),
-        'constructor_name' => ( $options->{constructor_name} || 'new' ),
-        'constructor_class' => (
-            $options->{constructor_class} || 'Class::MOP::Method::Constructor'
-        ),
-        'destructor_class' => $options->{destructor_class},
-    }, $class;
-}
-
-## Metaclass compatibility
-{
-    my %base_metaclass = (
-        attribute_metaclass      => 'Class::MOP::Attribute',
-        method_metaclass         => 'Class::MOP::Method',
-        wrapped_method_metaclass => 'Class::MOP::Method::Wrapped',
-        instance_metaclass       => 'Class::MOP::Instance',
-        constructor_class        => 'Class::MOP::Method::Constructor',
-        destructor_class         => 'Class::MOP::Method::Destructor',
-    );
-
-    sub _base_metaclasses { %base_metaclass }
-}
-
-sub _check_metaclass_compatibility {
-    my $self = shift;
-
-    my @superclasses = $self->superclasses
-        or return;
-
-    $self->_fix_metaclass_incompatibility(@superclasses);
-
-    my %base_metaclass = $self->_base_metaclasses;
-
-    # this is always okay ...
-    return
-        if ref($self) eq 'Class::MOP::Class'
-            && all {
-                my $meta = $self->$_;
-                !defined($meta) || $meta eq $base_metaclass{$_};
-        }
-        keys %base_metaclass;
-
-    for my $superclass (@superclasses) {
-        $self->_check_class_metaclass_compatibility($superclass);
-    }
-
-    for my $metaclass_type ( keys %base_metaclass ) {
-        next unless defined $self->$metaclass_type;
-        for my $superclass (@superclasses) {
-            $self->_check_single_metaclass_compatibility( $metaclass_type,
-                $superclass );
-        }
-    }
-}
-
-sub _check_class_metaclass_compatibility {
-    my $self = shift;
-    my ( $superclass_name ) = @_;
-
-    if (!$self->_class_metaclass_is_compatible($superclass_name)) {
-        my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
-
-        my $super_meta_type = $super_meta->_real_ref_name;
-
-        $self->_throw_exception( IncompatibleMetaclassOfSuperclass => class_name           => $self->name,
-                                                              class_meta_type      => ref( $self ),
-                                                              superclass_name      => $superclass_name,
-                                                              superclass_meta_type => $super_meta_type
-                       );
-    }
-}
-
-sub _class_metaclass_is_compatible {
-    my $self = shift;
-    my ( $superclass_name ) = @_;
-
-    my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
-        || return 1;
-
-    my $super_meta_name = $super_meta->_real_ref_name;
-
-    return $self->_is_compatible_with($super_meta_name);
-}
-
-sub _check_single_metaclass_compatibility {
-    my $self = shift;
-    my ( $metaclass_type, $superclass_name ) = @_;
-
-    if (!$self->_single_metaclass_is_compatible($metaclass_type, $superclass_name)) {
-        my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
-
-        $self->_throw_exception( MetaclassTypeIncompatible => class_name      => $self->name,
-                                                      superclass_name => $superclass_name,
-                                                      metaclass_type  => $metaclass_type
-                       );
-    }
-}
-
-sub _single_metaclass_is_compatible {
-    my $self = shift;
-    my ( $metaclass_type, $superclass_name ) = @_;
-
-    my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
-        || return 1;
-
-    # for instance, Moose::Meta::Class has a error_class attribute, but
-    # Class::MOP::Class doesn't - this shouldn't be an error
-    return 1 unless $super_meta->can($metaclass_type);
-    # for instance, Moose::Meta::Class has a destructor_class, but
-    # Class::MOP::Class doesn't - this shouldn't be an error
-    return 1 unless defined $super_meta->$metaclass_type;
-    # if metaclass is defined in superclass but not here, it's not compatible
-    # this is a really odd case
-    return 0 unless defined $self->$metaclass_type;
-
-    return $self->$metaclass_type->_is_compatible_with($super_meta->$metaclass_type);
-}
-
-sub _fix_metaclass_incompatibility {
-    my $self = shift;
-    my @supers = map { Class::MOP::Class->initialize($_) } @_;
-
-    my $necessary = 0;
-    for my $super (@supers) {
-        $necessary = 1
-            if $self->_can_fix_metaclass_incompatibility($super);
-    }
-    return unless $necessary;
-
-    for my $super (@supers) {
-        if (!$self->_class_metaclass_is_compatible($super->name)) {
-            $self->_fix_class_metaclass_incompatibility($super);
-        }
-    }
-
-    my %base_metaclass = $self->_base_metaclasses;
-    for my $metaclass_type (keys %base_metaclass) {
-        for my $super (@supers) {
-            if (!$self->_single_metaclass_is_compatible($metaclass_type, $super->name)) {
-                $self->_fix_single_metaclass_incompatibility(
-                    $metaclass_type, $super
-                );
-            }
-        }
-    }
-}
-
-sub _can_fix_metaclass_incompatibility {
-    my $self = shift;
-    my ($super_meta) = @_;
-
-    return 1 if $self->_class_metaclass_can_be_made_compatible($super_meta);
-
-    my %base_metaclass = $self->_base_metaclasses;
-    for my $metaclass_type (keys %base_metaclass) {
-        return 1 if $self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type);
-    }
-
-    return;
-}
-
-sub _class_metaclass_can_be_made_compatible {
-    my $self = shift;
-    my ($super_meta) = @_;
-
-    return $self->_can_be_made_compatible_with($super_meta->_real_ref_name);
-}
-
-sub _single_metaclass_can_be_made_compatible {
-    my $self = shift;
-    my ($super_meta, $metaclass_type) = @_;
-
-    my $specific_meta = $self->$metaclass_type;
-
-    return unless $super_meta->can($metaclass_type);
-    my $super_specific_meta = $super_meta->$metaclass_type;
-
-    # for instance, Moose::Meta::Class has a destructor_class, but
-    # Class::MOP::Class doesn't - this shouldn't be an error
-    return unless defined $super_specific_meta;
-
-    # if metaclass is defined in superclass but not here, it's fixable
-    # this is a really odd case
-    return 1 unless defined $specific_meta;
-
-    return 1 if $specific_meta->_can_be_made_compatible_with($super_specific_meta);
-}
-
-sub _fix_class_metaclass_incompatibility {
-    my $self = shift;
-    my ( $super_meta ) = @_;
-
-    if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
-        ($self->is_pristine)
-            || $self->_throw_exception( CannotFixMetaclassCompatibility => class_name => $self->name,
-                                                                   superclass => $super_meta
-                              );
-
-        my $super_meta_name = $super_meta->_real_ref_name;
-
-        $self->_make_compatible_with($super_meta_name);
-    }
-}
-
-sub _fix_single_metaclass_incompatibility {
-    my $self = shift;
-    my ( $metaclass_type, $super_meta ) = @_;
-
-    if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
-        ($self->is_pristine)
-            || $self->_throw_exception( CannotFixMetaclassCompatibility => class_name     => $self->name,
-                                                                   superclass     => $super_meta,
-                                                                   metaclass_type => $metaclass_type
-                              );
-
-        my $new_metaclass = $self->$metaclass_type
-            ? $self->$metaclass_type->_get_compatible_metaclass($super_meta->$metaclass_type)
-            : $super_meta->$metaclass_type;
-        $self->{$metaclass_type} = $new_metaclass;
-    }
-}
-
-sub _restore_metaobjects_from {
-    my $self = shift;
-    my ($old_meta) = @_;
-
-    $self->_restore_metamethods_from($old_meta);
-    $self->_restore_metaattributes_from($old_meta);
-}
-
-sub _remove_generated_metaobjects {
-    my $self = shift;
-
-    for my $attr (map { $self->get_attribute($_) } $self->get_attribute_list) {
-        $attr->remove_accessors;
-    }
-}
-
-# creating classes with MOP ...
-
-sub create {
-    my $class = shift;
-    my @args = @_;
-
-    unshift @args, 'package' if @args % 2 == 1;
-    my %options = @args;
-
-    (ref $options{superclasses} eq 'ARRAY')
-        || __PACKAGE__->_throw_exception( CreateMOPClassTakesArrayRefOfSuperclasses => class  => $class,
-                                                                         params => \%options
-                          )
-            if exists $options{superclasses};
-
-    (ref $options{attributes} eq 'ARRAY')
-        || __PACKAGE__->_throw_exception( CreateMOPClassTakesArrayRefOfAttributes => class  => $class,
-                                                                       params => \%options
-                          )
-            if exists $options{attributes};
-
-    (ref $options{methods} eq 'HASH')
-        || __PACKAGE__->_throw_exception( CreateMOPClassTakesHashRefOfMethods => class  => $class,
-                                                                   params => \%options
-                          )
-            if exists $options{methods};
-
-    my $package      = delete $options{package};
-    my $superclasses = delete $options{superclasses};
-    my $attributes   = delete $options{attributes};
-    my $methods      = delete $options{methods};
-    my $meta_name    = exists $options{meta_name}
-                         ? delete $options{meta_name}
-                         : 'meta';
-
-    my $meta = $class->SUPER::create($package => %options);
-
-    $meta->_add_meta_method($meta_name)
-        if defined $meta_name;
-
-    $meta->superclasses(@{$superclasses})
-        if defined $superclasses;
-    # NOTE:
-    # process attributes first, so that they can
-    # install accessors, but locally defined methods
-    # can then overwrite them. It is maybe a little odd, but
-    # I think this should be the order of things.
-    if (defined $attributes) {
-        foreach my $attr (@{$attributes}) {
-            $meta->add_attribute($attr);
-        }
-    }
-    if (defined $methods) {
-        foreach my $method_name (keys %{$methods}) {
-            $meta->add_method($method_name, $methods->{$method_name});
-        }
-    }
-    return $meta;
-}
-
-# XXX: something more intelligent here?
-sub _anon_package_prefix { 'Class::MOP::Class::__ANON__::SERIAL::' }
-
-sub create_anon_class { shift->create_anon(@_) }
-sub is_anon_class     { shift->is_anon(@_)     }
-
-sub _anon_cache_key {
-    my $class = shift;
-    my %options = @_;
-    # Makes something like Super::Class|Super::Class::2
-    return join '=' => (
-        join( '|', sort @{ $options{superclasses} || [] } ),
-    );
-}
-
-# Instance Construction & Cloning
-
-sub new_object {
-    my $class = shift;
-
-    # NOTE:
-    # we need to protect the integrity of the
-    # Class::MOP::Class singletons here, so we
-    # delegate this to &construct_class_instance
-    # which will deal with the singletons
-    return $class->_construct_class_instance(@_)
-        if $class->name->isa('Class::MOP::Class');
-    return $class->_construct_instance(@_);
-}
-
-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;
-    if (my $instance_class = blessed($params->{__INSTANCE__})) {
-        ($instance_class eq $class->name)
-            || $class->_throw_exception( InstanceBlessedIntoWrongClass => class_name => $class->name,
-                                                                 params     => $params,
-                                                                 instance   => $params->{__INSTANCE__}
-                              );
-        $instance = $params->{__INSTANCE__};
-    }
-    elsif (exists $params->{__INSTANCE__}) {
-        $class->_throw_exception( InstanceMustBeABlessedReference => class_name => $class->name,
-                                                            params     => $params,
-                                                            instance   => $params->{__INSTANCE__}
-                       );
-    }
-    else {
-        $instance = $meta_instance->create_instance();
-    }
-    foreach my $attr ($class->get_all_attributes()) {
-        $attr->initialize_instance_slot($meta_instance, $instance, $params);
-    }
-    if (Class::MOP::metaclass_is_weak($class->name)) {
-        $meta_instance->_set_mop_slot($instance, $class);
-    }
-    return $instance;
-}
-
-sub _inline_new_object {
-    my $self = shift;
-
-    return (
-        'my $class = shift;',
-        '$class = Scalar::Util::blessed($class) || $class;',
-        $self->_inline_fallback_constructor('$class'),
-        $self->_inline_params('$params', '$class'),
-        $self->_inline_generate_instance('$instance', '$class'),
-        $self->_inline_slot_initializers,
-        $self->_inline_preserve_weak_metaclasses,
-        $self->_inline_extra_init,
-        'return $instance',
-    );
-}
-
-sub _inline_fallback_constructor {
-    my $self = shift;
-    my ($class) = @_;
-    return (
-        'return ' . $self->_generate_fallback_constructor($class),
-            'if ' . $class . ' ne \'' . $self->name . '\';',
-    );
-}
-
-sub _generate_fallback_constructor {
-    my $self = shift;
-    my ($class) = @_;
-    return 'Class::MOP::Class->initialize(' . $class . ')->new_object(@_)',
-}
-
-sub _inline_params {
-    my $self = shift;
-    my ($params, $class) = @_;
-    return (
-        'my ' . $params . ' = @_ == 1 ? $_[0] : {@_};',
-    );
-}
-
-sub _inline_generate_instance {
-    my $self = shift;
-    my ($inst, $class) = @_;
-    return (
-        'my ' . $inst . ' = ' . $self->_inline_create_instance($class) . ';',
-    );
-}
-
-sub _inline_create_instance {
-    my $self = shift;
-
-    return $self->get_meta_instance->inline_create_instance(@_);
-}
-
-sub _inline_slot_initializers {
-    my $self = shift;
-
-    my $idx = 0;
-
-    return map { $self->_inline_slot_initializer($_, $idx++) }
-               sort { $a->name cmp $b->name } $self->get_all_attributes;
-}
-
-sub _inline_slot_initializer {
-    my $self  = shift;
-    my ($attr, $idx) = @_;
-
-    if (defined(my $init_arg = $attr->init_arg)) {
-        my @source = (
-            'if (exists $params->{\'' . $init_arg . '\'}) {',
-                $self->_inline_init_attr_from_constructor($attr, $idx),
-            '}',
-        );
-        if (my @default = $self->_inline_init_attr_from_default($attr, $idx)) {
-            push @source, (
-                'else {',
-                    @default,
-                '}',
-            );
-        }
-        return @source;
-    }
-    elsif (my @default = $self->_inline_init_attr_from_default($attr, $idx)) {
-        return (
-            '{',
-                @default,
-            '}',
-        );
-    }
-    else {
-        return ();
-    }
-}
-
-sub _inline_init_attr_from_constructor {
-    my $self = shift;
-    my ($attr, $idx) = @_;
-
-    my @initial_value = $attr->_inline_set_value(
-        '$instance', '$params->{\'' . $attr->init_arg . '\'}',
-    );
-
-    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 = $attr->_inline_set_value('$instance', $default);
-
-    push @initial_value, (
-        '$attrs->[' . $idx . ']->set_initial_value(',
-            '$instance,',
-            $attr->_inline_instance_get('$instance'),
-        ');',
-    ) if $attr->has_initializer;
-
-    return @initial_value;
-}
-
-sub _inline_default_value {
-    my $self = shift;
-    my ($attr, $index) = @_;
-
-    if ($attr->has_default) {
-        # NOTE:
-        # default values can either be CODE refs
-        # in which case we need to call them. Or
-        # they can be scalars (strings/numbers)
-        # in which case we can just deal with them
-        # in the code we eval.
-        if ($attr->is_default_a_coderef) {
-            return '$defaults->[' . $index . ']->($instance)';
-        }
-        else {
-            return '$defaults->[' . $index . ']';
-        }
-    }
-    elsif ($attr->has_builder) {
-        return '$instance->' . $attr->builder;
-    }
-    else {
-        return;
-    }
-}
-
-sub _inline_preserve_weak_metaclasses {
-    my $self = shift;
-    if (Class::MOP::metaclass_is_weak($self->name)) {
-        return (
-            $self->_inline_set_mop_slot(
-                '$instance', 'Class::MOP::class_of($class)'
-            ) . ';'
-        );
-    }
-    else {
-        return ();
-    }
-}
-
-sub _inline_extra_init { }
-
-sub _eval_environment {
-    my $self = shift;
-
-    my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
-
-    my $defaults = [map { $_->default } @attrs];
-
-    return {
-        '$defaults' => \$defaults,
-    };
-}
-
-
-sub get_meta_instance {
-    my $self = shift;
-    $self->{'_meta_instance'} ||= $self->_create_meta_instance();
-}
-
-sub _create_meta_instance {
-    my $self = shift;
-
-    my $instance = $self->instance_metaclass->new(
-        associated_metaclass => $self,
-        attributes => [ $self->get_all_attributes() ],
-    );
-
-    $self->add_meta_instance_dependencies()
-        if $instance->is_dependent_on_superclasses();
-
-    return $instance;
-}
-
-# TODO: this is actually not being used!
-sub _inline_rebless_instance {
-    my $self = shift;
-
-    return $self->get_meta_instance->inline_rebless_instance_structure(@_);
-}
-
-sub _inline_get_mop_slot {
-    my $self = shift;
-
-    return $self->get_meta_instance->_inline_get_mop_slot(@_);
-}
-
-sub _inline_set_mop_slot {
-    my $self = shift;
-
-    return $self->get_meta_instance->_inline_set_mop_slot(@_);
-}
-
-sub _inline_clear_mop_slot {
-    my $self = shift;
-
-    return $self->get_meta_instance->_inline_clear_mop_slot(@_);
-}
-
-sub clone_object {
-    my $class    = shift;
-    my $instance = shift;
-    (blessed($instance) && $instance->isa($class->name))
-        || $class->_throw_exception( CloneObjectExpectsAnInstanceOfMetaclass => class_name => $class->name,
-                                                                       instance   => $instance,
-                          );
-    # NOTE:
-    # we need to protect the integrity of the
-    # Class::MOP::Class singletons here, they
-    # should not be cloned.
-    return $instance if $instance->isa('Class::MOP::Class');
-    $class->_clone_instance($instance, @_);
-}
-
-sub _clone_instance {
-    my ($class, $instance, %params) = @_;
-    (blessed($instance))
-        || $class->_throw_exception( OnlyInstancesCanBeCloned => class_name => $class->name,
-                                                        instance   => $instance,
-                                                        params     => \%params
-                          );
-    my $meta_instance = $class->get_meta_instance();
-    my $clone = $meta_instance->clone_instance($instance);
-    foreach my $attr ($class->get_all_attributes()) {
-        if ( defined( my $init_arg = $attr->init_arg ) ) {
-            if (exists $params{$init_arg}) {
-                $attr->set_value($clone, $params{$init_arg});
-            }
-        }
-    }
-    return $clone;
-}
-
-sub _force_rebless_instance {
-    my ($self, $instance, %params) = @_;
-    my $old_metaclass = Class::MOP::class_of($instance);
-
-    $old_metaclass->rebless_instance_away($instance, $self, %params)
-        if $old_metaclass;
-
-    my $meta_instance = $self->get_meta_instance;
-
-    if (Class::MOP::metaclass_is_weak($old_metaclass->name)) {
-        $meta_instance->_clear_mop_slot($instance);
-    }
-
-    # rebless!
-    # we use $_[1] here because of t/cmop/rebless_overload.t regressions
-    # on 5.8.8
-    $meta_instance->rebless_instance_structure($_[1], $self);
-
-    $self->_fixup_attributes_after_rebless($instance, $old_metaclass, %params);
-
-    if (Class::MOP::metaclass_is_weak($self->name)) {
-        $meta_instance->_set_mop_slot($instance, $self);
-    }
-}
-
-sub rebless_instance {
-    my ($self, $instance, %params) = @_;
-    my $old_metaclass = Class::MOP::class_of($instance);
-
-    my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance);
-    $self->name->isa($old_class)
-        || $self->_throw_exception( CanReblessOnlyIntoASubclass => class_name     => $self->name,
-                                                           instance       => $instance,
-                                                           instance_class => blessed( $instance ),
-                                                           params         => \%params,
-                          );
-
-    $self->_force_rebless_instance($_[1], %params);
-
-    return $instance;
-}
-
-sub rebless_instance_back {
-    my ( $self, $instance ) = @_;
-    my $old_metaclass = Class::MOP::class_of($instance);
-    my $old_class
-        = $old_metaclass ? $old_metaclass->name : blessed($instance);
-    $old_class->isa( $self->name )
-        || $self->_throw_exception( CanReblessOnlyIntoASuperclass => class_name     => $self->name,
-                                                             instance       => $instance,
-                                                             instance_class => blessed( $instance ),
-                          );
-
-    $self->_force_rebless_instance($_[1]);
-
-    return $instance;
-}
-
-sub rebless_instance_away {
-    # this intentionally does nothing, it is just a hook
-}
-
-sub _fixup_attributes_after_rebless {
-    my $self = shift;
-    my ($instance, $rebless_from, %params) = @_;
-    my $meta_instance = $self->get_meta_instance;
-
-    for my $attr ( $rebless_from->get_all_attributes ) {
-        next if $self->find_attribute_by_name( $attr->name );
-        $meta_instance->deinitialize_slot( $instance, $_ ) for $attr->slots;
-    }
-
-    foreach my $attr ( $self->get_all_attributes ) {
-        if ( $attr->has_value($instance) ) {
-            if ( defined( my $init_arg = $attr->init_arg ) ) {
-                $params{$init_arg} = $attr->get_value($instance)
-                    unless exists $params{$init_arg};
-            }
-            else {
-                $attr->set_value($instance, $attr->get_value($instance));
-            }
-        }
-    }
-
-    foreach my $attr ($self->get_all_attributes) {
-        $attr->initialize_instance_slot($meta_instance, $instance, \%params);
-    }
-}
-
-sub _attach_attribute {
-    my ($self, $attribute) = @_;
-    $attribute->attach_to_class($self);
-}
-
-sub _post_add_attribute {
-    my ( $self, $attribute ) = @_;
-
-    $self->invalidate_meta_instances;
-
-    # invalidate package flag here
-    try {
-        local $SIG{__DIE__};
-        $attribute->install_accessors;
-    }
-    catch {
-        $self->remove_attribute( $attribute->name );
-        die $_;
-    };
-}
-
-sub remove_attribute {
-    my $self = shift;
-
-    my $removed_attribute = $self->SUPER::remove_attribute(@_)
-        or return;
-
-    $self->invalidate_meta_instances;
-
-    $removed_attribute->remove_accessors;
-    $removed_attribute->detach_from_class;
-
-    return$removed_attribute;
-}
-
-sub find_attribute_by_name {
-    my ( $self, $attr_name ) = @_;
-
-    foreach my $class ( $self->linearized_isa ) {
-        # fetch the meta-class ...
-        my $meta = Class::MOP::Class->initialize($class);
-        return $meta->get_attribute($attr_name)
-            if $meta->has_attribute($attr_name);
-    }
-
-    return;
-}
-
-sub get_all_attributes {
-    my $self = shift;
-    my %attrs = map { %{ Class::MOP::Class->initialize($_)->_attribute_map } }
-        reverse $self->linearized_isa;
-    return values %attrs;
-}
-
-# Inheritance
-
-sub superclasses {
-    my $self     = shift;
-
-    my $isa = $self->get_or_add_package_symbol('@ISA');
-
-    if (@_) {
-        my @supers = @_;
-        @{$isa} = @supers;
-
-        # NOTE:
-        # on 5.8 and below, we need to call
-        # a method to get Perl to detect
-        # a cycle in the class hierarchy
-        my $class = $self->name;
-        $class->isa($class);
-
-        # NOTE:
-        # we need to check the metaclass
-        # compatibility here so that we can
-        # be sure that the superclass is
-        # not potentially creating an issues
-        # we don't know about
-
-        $self->_check_metaclass_compatibility();
-        $self->_superclasses_updated();
-    }
-
-    return @{$isa};
-}
-
-sub _superclasses_updated {
-    my $self = shift;
-    $self->update_meta_instance_dependencies();
-    # keep strong references to all our parents, so they don't disappear if
-    # they are anon classes and don't have any direct instances
-    $self->_superclass_metas(
-        map { Class::MOP::class_of($_) } $self->superclasses
-    );
-}
-
-sub _superclass_metas {
-    my $self = shift;
-    $self->{_superclass_metas} = [@_];
-}
-
-sub subclasses {
-    my $self = shift;
-    my $super_class = $self->name;
-
-    return @{ $super_class->mro::get_isarev() };
-}
-
-sub direct_subclasses {
-    my $self = shift;
-    my $super_class = $self->name;
-
-    return grep {
-        grep {
-            $_ eq $super_class
-        } Class::MOP::Class->initialize($_)->superclasses
-    } $self->subclasses;
-}
-
-sub linearized_isa {
-    return @{ mro::get_linear_isa( (shift)->name ) };
-}
-
-sub class_precedence_list {
-    my $self = shift;
-    my $name = $self->name;
-
-    unless (Class::MOP::IS_RUNNING_ON_5_10()) {
-        # NOTE:
-        # We need to check for circular inheritance here
-        # if we are not on 5.10, cause 5.8 detects it late.
-        # This will do nothing if all is well, and blow up
-        # otherwise. Yes, it's an ugly hack, better
-        # suggestions are welcome.
-        # - SL
-        ($name || return)->isa('This is a test for circular inheritance')
-    }
-
-    # if our mro is c3, we can
-    # just grab the linear_isa
-    if (mro::get_mro($name) eq 'c3') {
-        return @{ mro::get_linear_isa($name) }
-    }
-    else {
-        # NOTE:
-        # we can't grab the linear_isa for dfs
-        # since it has all the duplicates
-        # already removed.
-        return (
-            $name,
-            map {
-                Class::MOP::Class->initialize($_)->class_precedence_list()
-            } $self->superclasses()
-        );
-    }
-}
-
-sub _method_lookup_order {
-    return (shift->linearized_isa, 'UNIVERSAL');
-}
-
-## Methods
-
-{
-    my $fetch_and_prepare_method = sub {
-        my ($self, $method_name) = @_;
-        my $wrapped_metaclass = $self->wrapped_method_metaclass;
-        # fetch it locally
-        my $method = $self->get_method($method_name);
-        # if we don't have local ...
-        unless ($method) {
-            # try to find the next method
-            $method = $self->find_next_method_by_name($method_name);
-            # die if it does not exist
-            (defined $method)
-                || $self->_throw_exception( MethodNameNotFoundInInheritanceHierarchy => class_name  => $self->name,
-                                                                                method_name => $method_name
-                                  );
-            # and now make sure to wrap it
-            # even if it is already wrapped
-            # because we need a new sub ref
-            $method = $wrapped_metaclass->wrap($method,
-                package_name => $self->name,
-                name         => $method_name,
-            );
-        }
-        else {
-            # now make sure we wrap it properly
-            $method = $wrapped_metaclass->wrap($method,
-                package_name => $self->name,
-                name         => $method_name,
-            ) unless $method->isa($wrapped_metaclass);
-        }
-        $self->add_method($method_name => $method);
-        return $method;
-    };
-
-    sub add_before_method_modifier {
-        my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && length $method_name)
-            || $self->_throw_exception( MethodModifierNeedsMethodName => class_name => $self->name );
-        my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_before_modifier(
-            set_subname(':before' => $method_modifier)
-        );
-    }
-
-    sub add_after_method_modifier {
-        my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && length $method_name)
-            || $self->_throw_exception( MethodModifierNeedsMethodName => class_name => $self->name );
-        my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_after_modifier(
-            set_subname(':after' => $method_modifier)
-        );
-    }
-
-    sub add_around_method_modifier {
-        my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && length $method_name)
-            || $self->_throw_exception( MethodModifierNeedsMethodName => class_name => $self->name );
-        my $method = $fetch_and_prepare_method->($self, $method_name);
-        $method->add_around_modifier(
-            set_subname(':around' => $method_modifier)
-        );
-    }
-
-    # NOTE:
-    # the methods above used to be named like this:
-    #    ${pkg}::${method}:(before|after|around)
-    # but this proved problematic when using one modifier
-    # to wrap multiple methods (something which is likely
-    # to happen pretty regularly IMO). So instead of naming
-    # it like this, I have chosen to just name them purely
-    # with their modifier names, like so:
-    #    :(before|after|around)
-    # The fact is that in a stack trace, it will be fairly
-    # evident from the context what method they are attached
-    # to, and so don't need the fully qualified name.
-}
-
-sub find_method_by_name {
-    my ($self, $method_name) = @_;
-    (defined $method_name && length $method_name)
-        || $self->_throw_exception( MethodNameNotGiven => class_name => $self->name );
-    foreach my $class ($self->_method_lookup_order) {
-        my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
-        return $method if defined $method;
-    }
-    return;
-}
-
-sub get_all_methods {
-    my $self = shift;
-
-    my %methods;
-    for my $class ( reverse $self->_method_lookup_order ) {
-        my $meta = Class::MOP::Class->initialize($class);
-
-        $methods{ $_->name } = $_ for $meta->_get_local_methods;
-    }
-
-    return values %methods;
-}
-
-sub get_all_method_names {
-    my $self = shift;
-    map { $_->name } $self->get_all_methods;
-}
-
-sub find_all_methods_by_name {
-    my ($self, $method_name) = @_;
-    (defined $method_name && length $method_name)
-        || $self->_throw_exception( MethodNameNotGiven => class_name => $self->name );
-    my @methods;
-    foreach my $class ($self->_method_lookup_order) {
-        # fetch the meta-class ...
-        my $meta = Class::MOP::Class->initialize($class);
-        push @methods => {
-            name  => $method_name,
-            class => $class,
-            code  => $meta->get_method($method_name)
-        } if $meta->has_method($method_name);
-    }
-    return @methods;
-}
-
-sub find_next_method_by_name {
-    my ($self, $method_name) = @_;
-    (defined $method_name && length $method_name)
-        || $self->_throw_exception( MethodNameNotGiven => class_name => $self->name );
-    my @cpl = ($self->_method_lookup_order);
-    shift @cpl; # discard ourselves
-    foreach my $class (@cpl) {
-        my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
-        return $method if defined $method;
-    }
-    return;
-}
-
-sub update_meta_instance_dependencies {
-    my $self = shift;
-
-    if ( $self->{meta_instance_dependencies} ) {
-        return $self->add_meta_instance_dependencies;
-    }
-}
-
-sub add_meta_instance_dependencies {
-    my $self = shift;
-
-    $self->remove_meta_instance_dependencies;
-
-    my @attrs = $self->get_all_attributes();
-
-    my %seen;
-    my @classes = grep { not $seen{ $_->name }++ }
-        map { $_->associated_class } @attrs;
-
-    foreach my $class (@classes) {
-        $class->add_dependent_meta_instance($self);
-    }
-
-    $self->{meta_instance_dependencies} = \@classes;
-}
-
-sub remove_meta_instance_dependencies {
-    my $self = shift;
-
-    if ( my $classes = delete $self->{meta_instance_dependencies} ) {
-        foreach my $class (@$classes) {
-            $class->remove_dependent_meta_instance($self);
-        }
-
-        return $classes;
-    }
-
-    return;
-
-}
-
-sub add_dependent_meta_instance {
-    my ( $self, $metaclass ) = @_;
-    push @{ $self->{dependent_meta_instances} }, $metaclass;
-}
-
-sub remove_dependent_meta_instance {
-    my ( $self, $metaclass ) = @_;
-    my $name = $metaclass->name;
-    @$_ = grep { $_->name ne $name } @$_
-        for $self->{dependent_meta_instances};
-}
-
-sub invalidate_meta_instances {
-    my $self = shift;
-    $_->invalidate_meta_instance()
-        for $self, @{ $self->{dependent_meta_instances} };
-}
-
-sub invalidate_meta_instance {
-    my $self = shift;
-    undef $self->{_meta_instance};
-}
-
-# check if we can reinitialize
-sub is_pristine {
-    my $self = shift;
-
-    # if any local attr is defined
-    return if $self->get_attribute_list;
-
-    # or any non-declared methods
-    for my $method ( map { $self->get_method($_) } $self->get_method_list ) {
-        return if $method->isa("Class::MOP::Method::Generated");
-        # FIXME do we need to enforce this too? return unless $method->isa( $self->method_metaclass );
-    }
-
-    return 1;
-}
-
-## Class closing
-
-sub is_mutable   { 1 }
-sub is_immutable { 0 }
-
-sub immutable_options { %{ $_[0]{__immutable}{options} || {} } }
-
-sub _immutable_options {
-    my ( $self, @args ) = @_;
-
-    return (
-        inline_accessors   => 1,
-        inline_constructor => 1,
-        inline_destructor  => 0,
-        debug              => 0,
-        immutable_trait    => $self->immutable_trait,
-        constructor_name   => $self->constructor_name,
-        constructor_class  => $self->constructor_class,
-        destructor_class   => $self->destructor_class,
-        @args,
-    );
-}
-
-sub make_immutable {
-    my ( $self, @args ) = @_;
-
-    return $self unless $self->is_mutable;
-
-    my ($file, $line) = (caller)[1..2];
-
-    $self->_initialize_immutable(
-        file => $file,
-        line => $line,
-        $self->_immutable_options(@args),
-    );
-    $self->_rebless_as_immutable(@args);
-
-    return $self;
-}
-
-sub make_mutable {
-    my $self = shift;
-
-    if ( $self->is_immutable ) {
-        my @args = $self->immutable_options;
-        $self->_rebless_as_mutable();
-        $self->_remove_inlined_code(@args);
-        delete $self->{__immutable};
-        return $self;
-    }
-    else {
-        return;
-    }
-}
-
-sub _rebless_as_immutable {
-    my ( $self, @args ) = @_;
-
-    $self->{__immutable}{original_class} = ref $self;
-
-    bless $self => $self->_immutable_metaclass(@args);
-}
-
-sub _immutable_metaclass {
-    my ( $self, %args ) = @_;
-
-    if ( my $class = $args{immutable_metaclass} ) {
-        return $class;
-    }
-
-    my $trait = $args{immutable_trait} = $self->immutable_trait
-        || $self->_throw_exception( NoImmutableTraitSpecifiedForClass => class_name => $self->name,
-                                                                 params     => \%args
-                          );
-
-    my $meta      = $self->meta;
-    my $meta_attr = $meta->find_attribute_by_name("immutable_trait");
-
-    my $class_name;
-
-    if ( $meta_attr and $trait eq $meta_attr->default ) {
-        # if the trait is the same as the default we try and pick a
-        # predictable name for the immutable metaclass
-        $class_name = 'Class::MOP::Class::Immutable::' . ref($self);
-    }
-    else {
-        $class_name = join '::', 'Class::MOP::Class::Immutable::CustomTrait',
-            $trait, 'ForMetaClass', ref($self);
-    }
-
-    return $class_name
-        if Class::MOP::does_metaclass_exist($class_name);
-
-    # If the metaclass is a subclass of CMOP::Class which has had
-    # metaclass roles applied (via Moose), then we want to make sure
-    # that we preserve that anonymous class (see Fey::ORM for an
-    # example of where this matters).
-    my $meta_name = $meta->_real_ref_name;
-
-    my $immutable_meta = $meta_name->create(
-        $class_name,
-        superclasses => [ ref $self ],
-    );
-
-    Class::MOP::MiniTrait::apply( $immutable_meta, $trait );
-
-    $immutable_meta->make_immutable(
-        inline_constructor => 0,
-        inline_accessors   => 0,
-    );
-
-    return $class_name;
-}
-
-sub _remove_inlined_code {
-    my $self = shift;
-
-    $self->remove_method( $_->name ) for $self->_inlined_methods;
-
-    delete $self->{__immutable}{inlined_methods};
-}
-
-sub _inlined_methods { @{ $_[0]{__immutable}{inlined_methods} || [] } }
-
-sub _add_inlined_method {
-    my ( $self, $method ) = @_;
-
-    push @{ $self->{__immutable}{inlined_methods} ||= [] }, $method;
-}
-
-sub _initialize_immutable {
-    my ( $self, %args ) = @_;
-
-    $self->{__immutable}{options} = \%args;
-    $self->_install_inlined_code(%args);
-}
-
-sub _install_inlined_code {
-    my ( $self, %args ) = @_;
-
-    # FIXME
-    $self->_inline_accessors(%args)   if $args{inline_accessors};
-    $self->_inline_constructor(%args) if $args{inline_constructor};
-    $self->_inline_destructor(%args)  if $args{inline_destructor};
-}
-
-sub _rebless_as_mutable {
-    my $self = shift;
-
-    bless $self, $self->_get_mutable_metaclass_name;
-
-    return $self;
-}
-
-sub _inline_accessors {
-    my $self = shift;
-
-    foreach my $attr_name ( $self->get_attribute_list ) {
-        $self->get_attribute($attr_name)->install_accessors(1);
-    }
-}
-
-sub _inline_constructor {
-    my ( $self, %args ) = @_;
-
-    my $name = $args{constructor_name};
-    # A class may not even have a constructor, and that's okay.
-    return unless defined $name;
-
-    if ( $self->has_method($name) && !$args{replace_constructor} ) {
-        my $class = $self->name;
-        warn "Not inlining a constructor for $class since it defines"
-            . " its own constructor.\n"
-            . "If you are certain you don't need to inline your"
-            . " constructor, specify inline_constructor => 0 in your"
-            . " call to $class->meta->make_immutable\n";
-        return;
-    }
-
-    my $constructor_class = $args{constructor_class};
-
-    {
-        local $@;
-        use_package_optimistically($constructor_class);
-    }
-
-    my $constructor = $constructor_class->new(
-        options      => \%args,
-        metaclass    => $self,
-        is_inline    => 1,
-        package_name => $self->name,
-        name         => $name,
-        definition_context => {
-            description => "constructor " . $self->name . "::" . $name,
-            file        => $args{file},
-            line        => $args{line},
-        },
-    );
-
-    if ( $args{replace_constructor} or $constructor->can_be_inlined ) {
-        $self->add_method( $name => $constructor );
-        $self->_add_inlined_method($constructor);
-    }
-}
-
-sub _inline_destructor {
-    my ( $self, %args ) = @_;
-
-    ( exists $args{destructor_class} && defined $args{destructor_class} )
-        || $self->_throw_exception( NoDestructorClassSpecified => class_name => $self->name,
-                                                          params     => \%args,
-                          );
-
-    if ( $self->has_method('DESTROY') && ! $args{replace_destructor} ) {
-        my $class = $self->name;
-        warn "Not inlining a destructor for $class since it defines"
-            . " its own destructor.\n";
-        return;
-    }
-
-    my $destructor_class = $args{destructor_class};
-
-    {
-        local $@;
-        use_package_optimistically($destructor_class);
-    }
-
-    return unless $destructor_class->is_needed($self);
-
-    my $destructor = $destructor_class->new(
-        options      => \%args,
-        metaclass    => $self,
-        package_name => $self->name,
-        name         => 'DESTROY',
-        definition_context => {
-            description => "destructor " . $self->name . "::DESTROY",
-            file        => $args{file},
-            line        => $args{line},
-        },
-    );
-
-    if ( $args{replace_destructor} or $destructor->can_be_inlined ) {
-        $self->add_method( 'DESTROY' => $destructor );
-        $self->_add_inlined_method($destructor);
-    }
-}
-
-1;
-
-# ABSTRACT: Class Meta Object
-
-__END__
-
-=pod
-
-=encoding UTF-8
-
-=head1 NAME
-
-Class::MOP::Class - Class Meta Object
-
-=head1 VERSION
-
-version 2.2207
-
-=head1 SYNOPSIS
-
-  # assuming that class Foo
-  # has been defined, you can
-
-  # use this for introspection ...
-
-  # add a method to Foo ...
-  Foo->meta->add_method( 'bar' => sub {...} )
-
-  # get a list of all the classes searched
-  # the method dispatcher in the correct order
-  Foo->meta->class_precedence_list()
-
-  # remove a method from Foo
-  Foo->meta->remove_method('bar');
-
-  # or use this to actually create classes ...
-
-  Class::MOP::Class->create(
-      'Bar' => (
-          version      => '0.01',
-          superclasses => ['Foo'],
-          attributes   => [
-              Class::MOP::Attribute->new('$bar'),
-              Class::MOP::Attribute->new('$baz'),
-          ],
-          methods => {
-              calculate_bar => sub {...},
-              construct_baz => sub {...}
-          }
-      )
-  );
-
-=head1 DESCRIPTION
-
-The Class Protocol is the largest and most complex part of the
-Class::MOP meta-object protocol. It controls the introspection and
-manipulation of Perl 5 classes, and it can create them as well. The
-best way to understand what this module can do is to read the
-documentation for each of its methods.
-
-=head1 INHERITANCE
-
-C<Class::MOP::Class> is a subclass of L<Class::MOP::Module>.
-
-=head1 METHODS
-
-=head2 Class construction
-
-These methods all create new C<Class::MOP::Class> objects. These
-objects can represent existing classes or they can be used to create
-new classes from scratch.
-
-The metaclass object for a given class is a singleton. If you attempt
-to create a metaclass for the same class twice, you will just get the
-existing object.
-
-=over 4
-
-=item B<< Class::MOP::Class->create($package_name, %options) >>
-
-This method creates a new C<Class::MOP::Class> object with the given
-package name. It accepts a number of options:
-
-=over 8
-
-=item * version
-
-An optional version number for the newly created package.
-
-=item * authority
-
-An optional authority for the newly created package.
-See L<Class::MOP::Module/authority> for more details.
-
-=item * superclasses
-
-An optional array reference of superclass names.
-
-=item * methods
-
-An optional hash reference of methods for the class. The keys of the
-hash reference are method names and values are subroutine references.
-
-=item * attributes
-
-An optional array reference of L<Class::MOP::Attribute> objects.
-
-=item * meta_name
-
-Specifies the name to install the C<meta> method for this class under.
-If it is not passed, C<meta> is assumed, and if C<undef> is explicitly
-given, no meta method will be installed.
-
-=item * weaken
-
-If true, the metaclass that is stored in the global cache will be a
-weak reference.
-
-Classes created in this way are destroyed once the metaclass they are
-attached to goes out of scope, and will be removed from Perl's internal
-symbol table.
-
-All instances of a class with a weakened metaclass keep a special
-reference to the metaclass object, which prevents the metaclass from
-going out of scope while any instances exist.
-
-This only works if the instance is based on a hash reference, however.
-
-=back
-
-=item B<< Class::MOP::Class->create_anon_class(%options) >>
-
-This method works just like C<< Class::MOP::Class->create >> but it
-creates an "anonymous" class. In fact, the class does have a name, but
-that name is a unique name generated internally by this module.
-
-It accepts the same C<superclasses>, C<methods>, and C<attributes>
-parameters that C<create> accepts.
-
-It also accepts a C<cache> option. If this is C<true>, then the anonymous class
-will be cached based on its superclasses and roles. If an existing anonymous
-class in the cache has the same superclasses and roles, it will be reused.
-
-Anonymous classes default to C<< weaken => 1 >> if cache is C<false>, although
-this can be overridden.
-
-=item B<< Class::MOP::Class->initialize($package_name, %options) >>
-
-This method will initialize a C<Class::MOP::Class> object for the
-named package. Unlike C<create>, this method I<will not> create a new
-class.
-
-The purpose of this method is to retrieve a C<Class::MOP::Class>
-object for introspecting an existing class.
-
-If an existing C<Class::MOP::Class> object exists for the named
-package, it will be returned, and any options provided will be
-ignored!
-
-If the object does not yet exist, it will be created.
-
-The valid options that can be passed to this method are
-C<attribute_metaclass>, C<method_metaclass>,
-C<wrapped_method_metaclass>, and C<instance_metaclass>. These are all
-optional, and default to the appropriate class in the C<Class::MOP>
-distribution.
-
-=back
-
-=head2 Object instance construction and cloning
-
-These methods are all related to creating and/or cloning object
-instances.
-
-=over 4
-
-=item B<< $metaclass->clone_object($instance, %params) >>
-
-This method clones an existing object instance. Any parameters you
-provide are will override existing attribute values in the object.
-
-This is a convenience method for cloning an object instance, then
-blessing it into the appropriate package.
-
-You could implement a clone method in your class, using this method:
-
-  sub clone {
-      my ($self, %params) = @_;
-      $self->meta->clone_object($self, %params);
-  }
-
-=item B<< $metaclass->rebless_instance($instance, %params) >>
-
-This method changes the class of C<$instance> to the metaclass's class.
-
-You can only rebless an instance into a subclass of its current
-class. If you pass any additional parameters, these will be treated
-like constructor parameters and used to initialize the object's
-attributes. Any existing attributes that are already set will be
-overwritten.
-
-Before reblessing the instance, this method will call
-C<rebless_instance_away> on the instance's current metaclass. This method
-will be passed the instance, the new metaclass, and any parameters
-specified to C<rebless_instance>. By default, C<rebless_instance_away>
-does nothing; it is merely a hook.
-
-=item B<< $metaclass->rebless_instance_back($instance) >>
-
-Does the same thing as C<rebless_instance>, except that you can only
-rebless an instance into one of its superclasses. Any attributes that
-do not exist in the superclass will be deinitialized.
-
-This is a much more dangerous operation than C<rebless_instance>,
-especially when multiple inheritance is involved, so use this carefully!
-
-=item B<< $metaclass->new_object(%params) >>
-
-This method is used to create a new object of the metaclass's
-class. Any parameters you provide are used to initialize the
-instance's attributes. A special C<__INSTANCE__> key can be passed to
-provide an already generated instance, rather than having Class::MOP
-generate it for you. This is mostly useful for using Class::MOP with
-foreign classes which generate instances using their own constructors.
-
-=item B<< $metaclass->instance_metaclass >>
-
-Returns the class name of the instance metaclass. See
-L<Class::MOP::Instance> for more information on the instance
-metaclass.
-
-=item B<< $metaclass->get_meta_instance >>
-
-Returns an instance of the C<instance_metaclass> to be used in the
-construction of a new instance of the class.
-
-=back
-
-=head2 Informational predicates
-
-These are a few predicate methods for asking information about the
-class itself.
-
-=over 4
-
-=item B<< $metaclass->is_anon_class >>
-
-This returns true if the class was created by calling C<<
-Class::MOP::Class->create_anon_class >>.
-
-=item B<< $metaclass->is_mutable >>
-
-This returns true if the class is still mutable.
-
-=item B<< $metaclass->is_immutable >>
-
-This returns true if the class has been made immutable.
-
-=item B<< $metaclass->is_pristine >>
-
-A class is I<not> pristine if it has non-inherited attributes or if it
-has any generated methods.
-
-=back
-
-=head2 Inheritance Relationships
-
-=over 4
-
-=item B<< $metaclass->superclasses(@superclasses) >>
-
-This is a read-write accessor which represents the superclass
-relationships of the metaclass's class.
-
-This is basically sugar around getting and setting C<@ISA>.
-
-=item B<< $metaclass->class_precedence_list >>
-
-This returns a list of all of the class's ancestor classes. The
-classes are returned in method dispatch order.
-
-=item B<< $metaclass->linearized_isa >>
-
-This returns a list based on C<class_precedence_list> but with all
-duplicates removed.
-
-=item B<< $metaclass->subclasses >>
-
-This returns a list of all subclasses for this class, even indirect
-subclasses.
-
-=item B<< $metaclass->direct_subclasses >>
-
-This returns a list of immediate subclasses for this class, which does not
-include indirect subclasses.
-
-=back
-
-=head2 Method introspection and creation
-
-These methods allow you to introspect a class's methods, as well as
-add, remove, or change methods.
-
-Determining what is truly a method in a Perl 5 class requires some
-heuristics (aka guessing).
-
-Methods defined outside the package with a fully qualified name (C<sub
-Package::name { ... }>) will be included. Similarly, methods named with a
-fully qualified name using L<Sub::Util> are also included.
-
-However, we attempt to ignore imported functions.
-
-Ultimately, we are using heuristics to determine what truly is a
-method in a class, and these heuristics may get the wrong answer in
-some edge cases. However, for most "normal" cases the heuristics work
-correctly.
-
-=over 4
-
-=item B<< $metaclass->get_method($method_name) >>
-
-This will return a L<Class::MOP::Method> for the specified
-C<$method_name>. If the class does not have the specified method, it
-returns C<undef>
-
-=item B<< $metaclass->has_method($method_name) >>
-
-Returns a boolean indicating whether or not the class defines the
-named method. It does not include methods inherited from parent
-classes.
-
-=item B<< $metaclass->get_method_list >>
-
-This will return a list of method I<names> for all methods defined in
-this class.
-
-=item B<< $metaclass->add_method($method_name, $method) >>
-
-This method takes a method name and a subroutine reference, and adds
-the method to the class.
-
-The subroutine reference can be a L<Class::MOP::Method>, and you are
-strongly encouraged to pass a meta method object instead of a code
-reference. If you do so, that object gets stored as part of the
-class's method map directly. If not, the meta information will have to
-be recreated later, and may be incorrect.
-
-If you provide a method object, this method will clone that object if
-the object's package name does not match the class name. This lets us
-track the original source of any methods added from other classes
-(notably Moose roles).
-
-=item B<< $metaclass->remove_method($method_name) >>
-
-Remove the named method from the class. This method returns the
-L<Class::MOP::Method> object for the method.
-
-=item B<< $metaclass->method_metaclass >>
-
-Returns the class name of the method metaclass, see
-L<Class::MOP::Method> for more information on the method metaclass.
-
-=item B<< $metaclass->wrapped_method_metaclass >>
-
-Returns the class name of the wrapped method metaclass, see
-L<Class::MOP::Method::Wrapped> for more information on the wrapped
-method metaclass.
-
-=item B<< $metaclass->get_all_methods >>
-
-This will traverse the inheritance hierarchy and return a list of all
-the L<Class::MOP::Method> objects for this class and its parents.
-
-=item B<< $metaclass->find_method_by_name($method_name) >>
-
-This will return a L<Class::MOP::Method> for the specified
-C<$method_name>. If the class does not have the specified method, it
-returns C<undef>
-
-Unlike C<get_method>, this method I<will> look for the named method in
-superclasses.
-
-=item B<< $metaclass->get_all_method_names >>
-
-This will return a list of method I<names> for all of this class's
-methods, including inherited methods.
-
-=item B<< $metaclass->find_all_methods_by_name($method_name) >>
-
-This method looks for the named method in the class and all of its
-parents. It returns every matching method it finds in the inheritance
-tree, so it returns a list of methods.
-
-Each method is returned as a hash reference with three keys. The keys
-are C<name>, C<class>, and C<code>. The C<code> key has a
-L<Class::MOP::Method> object as its value.
-
-The list of methods is distinct.
-
-=item B<< $metaclass->find_next_method_by_name($method_name) >>
-
-This method returns the first method in any superclass matching the
-given name. It is effectively the method that C<SUPER::$method_name>
-would dispatch to.
-
-=back
-
-=head2 Attribute introspection and creation
-
-Because Perl 5 does not have a core concept of attributes in classes,
-we can only return information about attributes which have been added
-via this class's methods. We cannot discover information about
-attributes which are defined in terms of "regular" Perl 5 methods.
-
-=over 4
-
-=item B<< $metaclass->get_attribute($attribute_name) >>
-
-This will return a L<Class::MOP::Attribute> for the specified
-C<$attribute_name>. If the class does not have the specified
-attribute, it returns C<undef>.
-
-NOTE that get_attribute does not search superclasses, for that you
-need to use C<find_attribute_by_name>.
-
-=item B<< $metaclass->has_attribute($attribute_name) >>
-
-Returns a boolean indicating whether or not the class defines the
-named attribute. It does not include attributes inherited from parent
-classes.
-
-=item B<< $metaclass->get_attribute_list >>
-
-This will return a list of attributes I<names> for all attributes
-defined in this class.  Note that this operates on the current class
-only, it does not traverse the inheritance hierarchy.
-
-=item B<< $metaclass->get_all_attributes >>
-
-This will traverse the inheritance hierarchy and return a list of all
-the L<Class::MOP::Attribute> objects for this class and its parents.
-
-=item B<< $metaclass->find_attribute_by_name($attribute_name) >>
-
-This will return a L<Class::MOP::Attribute> for the specified
-C<$attribute_name>. If the class does not have the specified
-attribute, it returns C<undef>.
-
-Unlike C<get_attribute>, this attribute I<will> look for the named
-attribute in superclasses.
-
-=item B<< $metaclass->add_attribute(...) >>
-
-This method accepts either an existing L<Class::MOP::Attribute>
-object or parameters suitable for passing to that class's C<new>
-method.
-
-The attribute provided will be added to the class.
-
-Any accessor methods defined by the attribute will be added to the
-class when the attribute is added.
-
-If an attribute of the same name already exists, the old attribute
-will be removed first.
-
-=item B<< $metaclass->remove_attribute($attribute_name) >>
-
-This will remove the named attribute from the class, and
-L<Class::MOP::Attribute> object.
-
-Removing an attribute also removes any accessor methods defined by the
-attribute.
-
-However, note that removing an attribute will only affect I<future>
-object instances created for this class, not existing instances.
-
-=item B<< $metaclass->attribute_metaclass >>
-
-Returns the class name of the attribute metaclass for this class. By
-default, this is L<Class::MOP::Attribute>.
-
-=back
-
-=head2 Overload introspection and creation
-
-These methods provide an API to the core L<overload> functionality.
-
-=over 4
-
-=item B<< $metaclass->is_overloaded >>
-
-Returns true if overloading is enabled for this class. Corresponds to
-L<Devel::OverloadInfo/is_overloaded>.
-
-=item B<< $metaclass->get_overloaded_operator($op) >>
-
-Returns the L<Class::MOP::Overload> object corresponding to the operator named
-C<$op>, if one exists for this class.
-
-=item B<< $metaclass->has_overloaded_operator($op) >>
-
-Returns whether or not the operator C<$op> is overloaded for this class.
-
-=item B<< $metaclass->get_overload_list >>
-
-Returns a list of operator names which have been overloaded (see
-L<overload/Overloadable Operations> for the list of valid operator names).
-
-=item B<< $metaclass->get_all_overloaded_operators >>
-
-Returns a list of L<Class::MOP::Overload> objects corresponding to the
-operators that have been overloaded.
-
-=item B<< $metaclass->add_overloaded_operator($op, $impl) >>
-
-Overloads the operator C<$op> for this class. The C<$impl> can be a coderef, a
-method name, or a L<Class::MOP::Overload> object. Corresponds to
-C<< use overload $op => $impl; >>
-
-=item B<< $metaclass->remove_overloaded_operator($op) >>
-
-Remove overloading for operator C<$op>. Corresponds to C<< no overload $op; >>
-
-=item B<< $metaclass->get_overload_fallback_value >>
-
-Returns the overload C<fallback> setting for the package.
-
-=item B<< $metaclass->set_overload_fallback_value($fallback) >>
-
-Sets the overload C<fallback> setting for the package.
-
-=back
-
-=head2 Class Immutability
-
-Making a class immutable "freezes" the class definition. You can no
-longer call methods which alter the class, such as adding or removing
-methods or attributes.
-
-Making a class immutable lets us optimize the class by inlining some
-methods, and also allows us to optimize some methods on the metaclass
-object itself.
-
-After immutabilization, the metaclass object will cache most informational
-methods that returns information about methods or attributes. Methods which
-would alter the class, such as C<add_attribute> and C<add_method>, will
-throw an error on an immutable metaclass object.
-
-The immutabilization system in L<Moose> takes much greater advantage
-of the inlining features than Class::MOP itself does.
-
-=over 4
-
-=item B<< $metaclass->make_immutable(%options) >>
-
-This method will create an immutable transformer and use it to make
-the class and its metaclass object immutable, and returns true
-(you should not rely on the details of this value apart from its truth).
-
-This method accepts the following options:
-
-=over 8
-
-=item * inline_accessors
-
-=item * inline_constructor
-
-=item * inline_destructor
-
-These are all booleans indicating whether the specified method(s)
-should be inlined.
-
-By default, accessors and the constructor are inlined, but not the
-destructor.
-
-=item * immutable_trait
-
-The name of a class which will be used as a parent class for the
-metaclass object being made immutable. This "trait" implements the
-post-immutability functionality of the metaclass (but not the
-transformation itself).
-
-This defaults to L<Class::MOP::Class::Immutable::Trait>.
-
-=item * constructor_name
-
-This is the constructor method name. This defaults to "new".
-
-=item * constructor_class
-
-The name of the method metaclass for constructors. It will be used to
-generate the inlined constructor. This defaults to
-"Class::MOP::Method::Constructor".
-
-=item * replace_constructor
-
-This is a boolean indicating whether an existing constructor should be
-replaced when inlining a constructor. This defaults to false.
-
-=item * destructor_class
-
-The name of the method metaclass for destructors. It will be used to
-generate the inlined destructor. This defaults to
-"Class::MOP::Method::Denstructor".
-
-=item * replace_destructor
-
-This is a boolean indicating whether an existing destructor should be
-replaced when inlining a destructor. This defaults to false.
-
-=back
-
-=item B<< $metaclass->immutable_options >>
-
-Returns a hash of the options used when making the class immutable, including
-both defaults and anything supplied by the user in the call to C<<
-$metaclass->make_immutable >>. This is useful if you need to temporarily make
-a class mutable and then restore immutability as it was before.
-
-=item B<< $metaclass->make_mutable >>
-
-Calling this method reverse the immutabilization transformation.
-
-=back
-
-=head2 Method Modifiers
-
-Method modifiers are hooks which allow a method to be wrapped with
-I<before>, I<after> and I<around> method modifiers. Every time a
-method is called, its modifiers are also called.
-
-A class can modify its own methods, as well as methods defined in
-parent classes.
-
-=head3 How method modifiers work?
-
-Method modifiers work by wrapping the original method and then
-replacing it in the class's symbol table. The wrappers will handle
-calling all the modifiers in the appropriate order and preserving the
-calling context for the original method.
-
-The return values of C<before> and C<after> modifiers are
-ignored. This is because their purpose is B<not> to filter the input
-and output of the primary method (this is done with an I<around>
-modifier).
-
-This may seem like an odd restriction to some, but doing this allows
-for simple code to be added at the beginning or end of a method call
-without altering the function of the wrapped method or placing any
-extra responsibility on the code of the modifier.
-
-Of course if you have more complex needs, you can use the C<around>
-modifier which allows you to change both the parameters passed to the
-wrapped method, as well as its return value.
-
-Before and around modifiers are called in last-defined-first-called
-order, while after modifiers are called in first-defined-first-called
-order. So the call tree might looks something like this:
-
-  before 2
-   before 1
-    around 2
-     around 1
-      primary
-     around 1
-    around 2
-   after 1
-  after 2
-
-=head3 What is the performance impact?
-
-Of course there is a performance cost associated with method
-modifiers, but we have made every effort to make that cost directly
-proportional to the number of modifier features you use.
-
-The wrapping method does its best to B<only> do as much work as it
-absolutely needs to. In order to do this we have moved some of the
-performance costs to set-up time, where they are easier to amortize.
-
-All this said, our benchmarks have indicated the following:
-
-  simple wrapper with no modifiers             100% slower
-  simple wrapper with simple before modifier   400% slower
-  simple wrapper with simple after modifier    450% slower
-  simple wrapper with simple around modifier   500-550% slower
-  simple wrapper with all 3 modifiers          1100% slower
-
-These numbers may seem daunting, but you must remember, every feature
-comes with some cost. To put things in perspective, just doing a
-simple C<AUTOLOAD> which does nothing but extract the name of the
-method called and return it costs about 400% over a normal method
-call.
-
-=over 4
-
-=item B<< $metaclass->add_before_method_modifier($method_name, $code) >>
-
-This wraps the specified method with the supplied subroutine
-reference. The modifier will be called as a method itself, and will
-receive the same arguments as are passed to the method.
-
-When the modifier exits, the wrapped method will be called.
-
-The return value of the modifier will be ignored.
-
-=item B<< $metaclass->add_after_method_modifier($method_name, $code) >>
-
-This wraps the specified method with the supplied subroutine
-reference. The modifier will be called as a method itself, and will
-receive the same arguments as are passed to the method.
-
-When the wrapped methods exits, the modifier will be called.
-
-The return value of the modifier will be ignored.
-
-=item B<< $metaclass->add_around_method_modifier($method_name, $code) >>
-
-This wraps the specified method with the supplied subroutine
-reference.
-
-The first argument passed to the modifier will be a subroutine
-reference to the wrapped method. The second argument is the object,
-and after that come any arguments passed when the method is called.
-
-The around modifier can choose to call the original method, as well as
-what arguments to pass if it does so.
-
-The return value of the modifier is what will be seen by the caller.
-
-=back
-
-=head2 Introspection
-
-=over 4
-
-=item B<< Class::MOP::Class->meta >>
-
-This will return a L<Class::MOP::Class> instance for this class.
-
-It should also be noted that L<Class::MOP> will actually bootstrap
-this module by installing a number of attribute meta-objects into its
-metaclass.
-
-=back
-
-=head1 AUTHORS
-
-=over 4
-
-=item *
-
-Stevan Little <stevan@cpan.org>
-
-=item *
-
-Dave Rolsky <autarch@urth.org>
-
-=item *
-
-Jesse Luehrs <doy@cpan.org>
-
-=item *
-
-Shawn M Moore <sartak@cpan.org>
-
-=item *
-
-יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
-
-=item *
-
-Karen Etheridge <ether@cpan.org>
-
-=item *
-
-Florian Ragwitz <rafl@debian.org>
-
-=item *
-
-Hans Dieter Pearcey <hdp@cpan.org>
-
-=item *
-
-Chris Prather <chris@prather.org>
-
-=item *
-
-Matt S Trout <mstrout@cpan.org>
-
-=back
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is copyright (c) 2006 by Infinity Interactive, Inc.
-
-This is free software; you can redistribute it and/or modify it under
-the same terms as the Perl 5 programming language system itself.
-
-=cut