X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=5066d3d616873dd978defda58e755c2d0d62eeb4;hb=28fa06b5d932b8a2f9bc1b6b394893c0d7c9efac;hp=1e99bdfcc4478623c3fd1cfb2c5d0e57079773e1;hpb=ebce55398177423965f0582686a812fe79e20d70;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 1e99bdf..5066d3d 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -4,10 +4,13 @@ package Class::MOP;
 use strict;
 use warnings;
 
+use 5.008;
+
 use MRO::Compat;
 
 use Carp          'confess';
-use Scalar::Util  'weaken';
+use Scalar::Util  'weaken', 'reftype';
+
 
 use Class::MOP::Class;
 use Class::MOP::Attribute;
@@ -16,88 +19,64 @@ use Class::MOP::Method;
 use Class::MOP::Immutable;
 
 BEGIN {
-    
-    our $VERSION   = '0.62';
-    our $AUTHORITY = 'cpan:STEVAN';    
-    
     *IS_RUNNING_ON_5_10 = ($] < 5.009_005) 
         ? sub () { 0 }
         : sub () { 1 };    
 
-    # NOTE:
-    # we may not use this yet, but once 
-    # the get_code_info XS gets merged 
-    # upstream to it, we will always use 
-    # it. But for now it is just kinda 
-    # extra overhead.
-    # - SL
+    *HAVE_ISAREV = defined(&mro::get_isarev)
+        ? sub () { 1 }
+        : sub () { 1 };
+
+    # this is either part of core or set up appropriately by MRO::Compat
+    *check_package_cache_flag = \&mro::get_pkg_gen;
+}
+
+our $VERSION   = '0.78';
+our $XS_VERSION = $VERSION;
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';    
+
+_try_load_xs() or _load_pure_perl();
+
+sub _try_load_xs {
+    return if $ENV{CLASS_MOP_NO_XS};
+
+    my $e = do {
+        local $@;
+        eval {
+            require XSLoader;
+            # just doing this - no warnings 'redefine' - doesn't work
+            # for some reason
+            local $^W = 0;
+            __PACKAGE__->XSLoader::load($XS_VERSION);
+
+            require Sub::Name;
+            Sub::Name->import(qw(subname));
+
+            require Devel::GlobalDestruction;
+            Devel::GlobalDestruction->import("in_global_destruction");
+
+            *USING_XS = sub () { 1 };
+        };
+        $@;
+    };
+
+    die $e if $e && $e !~ /object version|loadable object/;
+
+    return $e ? 0 : 1;
+}
+
+sub _load_pure_perl {
     require Sub::Identify;
-        
-    # stash these for a sec, and see how things go
-    my $_PP_subname       = sub { $_[1] };
-    my $_PP_get_code_info = \&Sub::Identify::get_code_info;    
-    
-    if ($ENV{CLASS_MOP_NO_XS}) {
-        # NOTE:
-        # this is if you really want things
-        # to be slow, then you can force the
-        # no-XS rule this way, otherwise we 
-        # make an effort to load as much of 
-        # the XS as possible.
-        # - SL
-        no warnings 'prototype', 'redefine';
-        
-        unless (IS_RUNNING_ON_5_10()) {
-            # get this from MRO::Compat ...
-            *check_package_cache_flag = \&MRO::Compat::__get_pkg_gen_pp;
-        }
-        else {
-            # NOTE:
-            # but if we are running 5.10 
-            # there is no need to use the 
-            # Pure Perl version since we 
-            # can use the built in mro 
-            # version instead.
-            # - SL
-            *check_package_cache_flag = \&mro::get_pkg_gen; 
-        }
-        # our own version of Sub::Name
-        *subname       = $_PP_subname;
-        # and the Sub::Identify version of the get_code_info
-        *get_code_info = $_PP_get_code_info;        
-    }
-    else {
-        # now try our best to get as much 
-        # of the XS loaded as possible
-        {
-            local $@;
-            eval {
-                require XSLoader;
-                XSLoader::load( 'Class::MOP', $VERSION );            
-            };
-            die $@ if $@ && $@ !~ /object version|loadable object/;
-            
-            # okay, so the XS failed to load, so 
-            # use the pure perl one instead.
-            *get_code_info = $_PP_get_code_info if $@; 
-        }        
-        
-        # get it from MRO::Compat
-        *check_package_cache_flag = \&mro::get_pkg_gen;        
-        
-        # now try and load the Sub::Name 
-        # module and use that as a means
-        # for naming our CVs, if not, we 
-        # use the workaround instead.
-        if ( eval { require Sub::Name } ) {
-            *subname = \&Sub::Name::subname;
-        } 
-        else {
-            *subname = $_PP_subname;
-        }     
-    }
+    Sub::Identify->import('get_code_info');
+
+    *subname = sub { $_[1] };
+    *in_global_destruction = sub () { !1 };
+
+    *USING_XS = sub () { 0 };
 }
 
+
 {
     # Metaclasses are singletons, so we cache them here.
     # there is no need to worry about destruction though
@@ -123,33 +102,80 @@ BEGIN {
     # because I don't yet see a good reason to do so.
 }
 
-sub load_class {
-    my $class = shift;
+sub load_first_existing_class {
+    my @classes = @_
+        or return;
+
+    foreach my $class (@classes) {
+        unless ( _is_valid_class_name($class) ) {
+            my $display = defined($class) ? $class : 'undef';
+            confess "Invalid class name ($display)";
+        }
+    }
 
-    if (ref($class) || !defined($class) || !length($class)) {
-        my $display = defined($class) ? $class : 'undef';
-        confess "Invalid class name ($display)";
+    my $found;
+    my %exceptions;
+    for my $class (@classes) {
+        my $e = _try_load_one_class($class);
+
+        if ($e) {
+            $exceptions{$class} = $e;
+        }
+        else {
+            $found = $class;
+            last;
+        }
     }
 
-    # see if this is already
-    # loaded in the symbol table
-    return 1 if is_class_loaded($class);
-    # otherwise require it ...
+    return $found if $found;
+
+    confess join(
+        "\n",
+        map {
+            sprintf(
+                "Could not load class (%s) because : %s", $_,
+                $exceptions{$_}
+                )
+            } @classes
+    );
+}
+
+sub _try_load_one_class {
+    my $class = shift;
+
+    return if is_class_loaded($class);
+
     my $file = $class . '.pm';
     $file =~ s{::}{/}g;
-    eval { CORE::require($file) };
-    confess "Could not load class ($class) because : $@" if $@;
-    unless (does_metaclass_exist($class)) {
-        eval { Class::MOP::Class->initialize($class) };
-        confess "Could not initialize class ($class) because : $@" if $@;
-    }
-    1; # return true if it worked
+
+    return do {
+        local $@;
+        eval { require($file) };
+        $@;
+    };
+}
+
+sub load_class {
+    my $class = load_first_existing_class($_[0]);
+    return get_metaclass_by_name($class) || $class;
+}
+
+sub _is_valid_class_name {
+    my $class = shift;
+
+    return 0 if ref($class);
+    return 0 unless defined($class);
+    return 0 unless length($class);
+
+    return 1 if $class =~ /^\w+(?:::\w+)*$/;
+
+    return 0;
 }
 
 sub is_class_loaded {
     my $class = shift;
 
-    return 0 if ref($class) || !defined($class) || !length($class);
+    return 0 unless _is_valid_class_name($class);
 
     # walk the symbol table tree to avoid autovififying
     # \*{${main::}{"Foo::"}} == \*main::Foo::
@@ -160,9 +186,19 @@ sub is_class_loaded {
         $pack = \*{${$$pack}{"${part}::"}};
     }
 
-    # check for $VERSION or @ISA
-    return 1 if exists ${$$pack}{VERSION}
-             && defined *{${$$pack}{VERSION}}{SCALAR};
+    # We used to check in the package stash, but it turns out that
+    # *{${$$package}{VERSION}{SCALAR}} can end up pointing to a
+    # reference to undef. It looks
+
+    my $version = do {
+        no strict 'refs';
+        ${$class . '::VERSION'};
+    };
+
+    return 1 if ! ref $version && defined $version;
+    # Sometimes $VERSION ends up as a reference to undef (weird)
+    return 1 if ref $version && reftype $version eq 'SCALAR' && defined ${$version};
+
     return 1 if exists ${$$pack}{ISA}
              && defined *{${$$pack}{ISA}}{ARRAY};
 
@@ -213,7 +249,7 @@ sub is_class_loaded {
 ## Class::MOP::Package
 
 Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('$!package' => (
+    Class::MOP::Attribute->new('package' => (
         reader   => {
             # NOTE: we need to do this in order
             # for the instance meta-object to
@@ -223,12 +259,11 @@ Class::MOP::Package->meta->add_attribute(
             # rather than re-produce it here
             'name' => \&Class::MOP::Package::name
         },
-        init_arg => 'package',
     ))
 );
 
 Class::MOP::Package->meta->add_attribute(
-    Class::MOP::Attribute->new('%!namespace' => (
+    Class::MOP::Attribute->new('namespace' => (
         reader => {
             # NOTE:
             # we just alias the original method
@@ -240,15 +275,6 @@ Class::MOP::Package->meta->add_attribute(
     ))
 );
 
-# NOTE:
-# use the metaclass to construct the meta-package
-# which is a superclass of the metaclass itself :P
-Class::MOP::Package->meta->add_method('initialize' => sub {
-    my $class        = shift;
-    my $package_name = shift;
-    $class->meta->new_object('package' => $package_name, @_);
-});
-
 ## --------------------------------------------------------
 ## Class::MOP::Module
 
@@ -263,7 +289,7 @@ Class::MOP::Package->meta->add_method('initialize' => sub {
 # the metaclass, isn't abstraction great :)
 
 Class::MOP::Module->meta->add_attribute(
-    Class::MOP::Attribute->new('$!version' => (
+    Class::MOP::Attribute->new('version' => (
         reader => {
             # NOTE:
             # we just alias the original method
@@ -282,7 +308,7 @@ Class::MOP::Module->meta->add_attribute(
 # well.
 
 Class::MOP::Module->meta->add_attribute(
-    Class::MOP::Attribute->new('$!authority' => (
+    Class::MOP::Attribute->new('authority' => (
         reader => {
             # NOTE:
             # we just alias the original method
@@ -298,7 +324,7 @@ Class::MOP::Module->meta->add_attribute(
 ## Class::MOP::Class
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('%!attributes' => (
+    Class::MOP::Attribute->new('attributes' => (
         reader   => {
             # NOTE: we need to do this in order
             # for the instance meta-object to
@@ -308,14 +334,12 @@ Class::MOP::Class->meta->add_attribute(
             # rather than re-produce it here
             'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
         },
-        init_arg => 'attributes',
         default  => sub { {} }
     ))
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('%!methods' => (
-        init_arg => 'methods',
+    Class::MOP::Attribute->new('methods' => (
         reader   => {
             # NOTE:
             # we just alias the original method
@@ -327,7 +351,7 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('@!superclasses' => (
+    Class::MOP::Attribute->new('superclasses' => (
         accessor => {
             # NOTE:
             # we just alias the original method
@@ -340,33 +364,43 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('$!attribute_metaclass' => (
+    Class::MOP::Attribute->new('attribute_metaclass' => (
         reader   => {
             # NOTE:
             # we just alias the original method
             # rather than re-produce it here
             'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass
         },
-        init_arg => 'attribute_metaclass',
         default  => 'Class::MOP::Attribute',
     ))
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('$!method_metaclass' => (
+    Class::MOP::Attribute->new('method_metaclass' => (
         reader   => {
             # NOTE:
             # we just alias the original method
             # rather than re-produce it here
             'method_metaclass' => \&Class::MOP::Class::method_metaclass
         },
-        init_arg => 'method_metaclass',
         default  => 'Class::MOP::Method',
     ))
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('$!instance_metaclass' => (
+    Class::MOP::Attribute->new('wrapped_method_metaclass' => (
+        reader   => {
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here
+            'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass
+        },
+        default  => 'Class::MOP::Method::Wrapped',
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('instance_metaclass' => (
         reader   => {
             # NOTE: we need to do this in order
             # for the instance meta-object to
@@ -376,7 +410,6 @@ Class::MOP::Class->meta->add_attribute(
             # rather than re-produce it here
             'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
         },
-        init_arg => 'instance_metaclass',
         default  => 'Class::MOP::Instance',
     ))
 );
@@ -391,8 +424,7 @@ Class::MOP::Class->meta->add_attribute(
 ## Class::MOP::Attribute
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!name' => (
-        init_arg => 'name',
+    Class::MOP::Attribute->new('name' => (
         reader   => {
             # NOTE: we need to do this in order
             # for the instance meta-object to
@@ -406,8 +438,7 @@ Class::MOP::Attribute->meta->add_attribute(
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!associated_class' => (
-        init_arg => 'associated_class',
+    Class::MOP::Attribute->new('associated_class' => (
         reader   => {
             # NOTE: we need to do this in order
             # for the instance meta-object to
@@ -421,115 +452,81 @@ Class::MOP::Attribute->meta->add_attribute(
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!accessor' => (
-        init_arg  => 'accessor',
+    Class::MOP::Attribute->new('accessor' => (
         reader    => { 'accessor'     => \&Class::MOP::Attribute::accessor     },
         predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!reader' => (
-        init_arg  => 'reader',
+    Class::MOP::Attribute->new('reader' => (
         reader    => { 'reader'     => \&Class::MOP::Attribute::reader     },
         predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!initializer' => (
-        init_arg  => 'initializer',
+    Class::MOP::Attribute->new('initializer' => (
         reader    => { 'initializer'     => \&Class::MOP::Attribute::initializer     },
         predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!writer' => (
-        init_arg  => 'writer',
+    Class::MOP::Attribute->new('definition_context' => (
+        reader    => { 'definition_context'     => \&Class::MOP::Attribute::definition_context     },
+    ))
+);
+
+Class::MOP::Attribute->meta->add_attribute(
+    Class::MOP::Attribute->new('writer' => (
         reader    => { 'writer'     => \&Class::MOP::Attribute::writer     },
         predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!predicate' => (
-        init_arg  => 'predicate',
+    Class::MOP::Attribute->new('predicate' => (
         reader    => { 'predicate'     => \&Class::MOP::Attribute::predicate     },
         predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!clearer' => (
-        init_arg  => 'clearer',
+    Class::MOP::Attribute->new('clearer' => (
         reader    => { 'clearer'     => \&Class::MOP::Attribute::clearer     },
         predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!builder' => (
-        init_arg  => 'builder',
+    Class::MOP::Attribute->new('builder' => (
         reader    => { 'builder'     => \&Class::MOP::Attribute::builder     },
         predicate => { 'has_builder' => \&Class::MOP::Attribute::has_builder },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!init_arg' => (
-        init_arg  => 'init_arg',
+    Class::MOP::Attribute->new('init_arg' => (
         reader    => { 'init_arg'     => \&Class::MOP::Attribute::init_arg     },
         predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('$!default' => (
-        init_arg  => 'default',
+    Class::MOP::Attribute->new('default' => (
         # default has a custom 'reader' method ...
         predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('@!associated_methods' => (
-        init_arg => 'associated_methods',
+    Class::MOP::Attribute->new('associated_methods' => (
         reader   => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
         default  => sub { [] }
     ))
 );
 
-# NOTE: (meta-circularity)
-# This should be one of the last things done
-# it will "tie the knot" with Class::MOP::Attribute
-# so that it uses the attributes meta-objects
-# to construct itself.
-Class::MOP::Attribute->meta->add_method('new' => sub {
-    my $class   = shift;
-    my $name    = shift;
-    my %options = @_;
-
-    (defined $name && $name)
-        || confess "You must provide a name for the attribute";
-    $options{init_arg} = $name
-        if not exists $options{init_arg};
-
-    if(exists $options{builder}){
-        confess("builder must be a defined scalar value which is a method name")
-            if ref $options{builder} || !(defined $options{builder});
-        confess("Setting both default and builder is not allowed.")
-            if exists $options{default};
-    } else {
-        (Class::MOP::Attribute::is_default_a_coderef(\%options))
-            || confess("References are not allowed as default values, you must ".
-                       "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
-                if exists $options{default} && ref $options{default};
-    }
-    # return the new object
-    $class->meta->new_object(name => $name, %options);
-});
-
 Class::MOP::Attribute->meta->add_method('clone' => sub {
     my $self  = shift;
     $self->meta->clone_object($self, @_);
@@ -537,46 +534,42 @@ Class::MOP::Attribute->meta->add_method('clone' => sub {
 
 ## --------------------------------------------------------
 ## Class::MOP::Method
-
 Class::MOP::Method->meta->add_attribute(
-    Class::MOP::Attribute->new('&!body' => (
-        init_arg => 'body',
+    Class::MOP::Attribute->new('body' => (
         reader   => { 'body' => \&Class::MOP::Method::body },
     ))
 );
 
 Class::MOP::Method->meta->add_attribute(
-    Class::MOP::Attribute->new('$!package_name' => (
-        init_arg => 'package_name',
+    Class::MOP::Attribute->new('associated_metaclass' => (
+        reader   => { 'associated_metaclass' => \&Class::MOP::Method::associated_metaclass },
+    ))
+);
+
+Class::MOP::Method->meta->add_attribute(
+    Class::MOP::Attribute->new('package_name' => (
         reader   => { 'package_name' => \&Class::MOP::Method::package_name },
     ))
 );
 
 Class::MOP::Method->meta->add_attribute(
-    Class::MOP::Attribute->new('$!name' => (
-        init_arg => 'name',
+    Class::MOP::Attribute->new('name' => (
         reader   => { 'name' => \&Class::MOP::Method::name },
     ))
 );
 
-Class::MOP::Method->meta->add_method('wrap' => sub {
-    my $class   = shift;
-    my $code    = shift;
-    my %options = @_;
-
-    ('CODE' eq ref($code))
-        || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
-
-    ($options{package_name} && $options{name})
-        || confess "You must supply the package_name and name parameters";
-
-    # return the new object
-    $class->meta->new_object(body => $code, %options);
-});
+Class::MOP::Method->meta->add_attribute(
+    Class::MOP::Attribute->new('original_method' => (
+        reader   => { 'original_method'      => \&Class::MOP::Method::original_method },
+        writer   => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
+    ))
+);
 
 Class::MOP::Method->meta->add_method('clone' => sub {
     my $self  = shift;
-    $self->meta->clone_object($self, @_);
+    my $clone = $self->meta->clone_object($self, @_);
+    $clone->_set_original_method($self);
+    return $clone;
 });
 
 ## --------------------------------------------------------
@@ -588,35 +581,30 @@ Class::MOP::Method->meta->add_method('clone' => sub {
 # practices of attributes, but we put
 # it here for completeness
 Class::MOP::Method::Wrapped->meta->add_attribute(
-    Class::MOP::Attribute->new('%!modifier_table')
+    Class::MOP::Attribute->new('modifier_table')
 );
 
 ## --------------------------------------------------------
 ## Class::MOP::Method::Generated
 
 Class::MOP::Method::Generated->meta->add_attribute(
-    Class::MOP::Attribute->new('$!is_inline' => (
-        init_arg => 'is_inline',
+    Class::MOP::Attribute->new('is_inline' => (
         reader   => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
         default  => 0, 
     ))
 );
 
-Class::MOP::Method::Generated->meta->add_method('new' => sub {
-    my ($class, %options) = @_;
-    ($options{package_name} && $options{name})
-        || confess "You must supply the package_name and name parameters";    
-    my $self = $class->meta->new_object(%options);
-    $self->initialize_body;  
-    $self;
-});
+Class::MOP::Method::Generated->meta->add_attribute(
+    Class::MOP::Attribute->new('definition_context' => (
+        reader   => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context },
+    ))
+);
 
 ## --------------------------------------------------------
 ## Class::MOP::Method::Accessor
 
 Class::MOP::Method::Accessor->meta->add_attribute(
-    Class::MOP::Attribute->new('$!attribute' => (
-        init_arg => 'attribute',
+    Class::MOP::Attribute->new('attribute' => (
         reader   => {
             'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
         },
@@ -624,48 +612,16 @@ Class::MOP::Method::Accessor->meta->add_attribute(
 );
 
 Class::MOP::Method::Accessor->meta->add_attribute(
-    Class::MOP::Attribute->new('$!accessor_type' => (
-        init_arg => 'accessor_type',
+    Class::MOP::Attribute->new('accessor_type' => (
         reader   => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
     ))
 );
 
-Class::MOP::Method::Accessor->meta->add_method('new' => sub {
-    my $class   = shift;
-    my %options = @_;
-
-    (exists $options{attribute})
-        || confess "You must supply an attribute to construct with";
-
-    (exists $options{accessor_type})
-        || confess "You must supply an accessor_type to construct with";
-
-    (Scalar::Util::blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
-        || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
-
-    ($options{package_name} && $options{name})
-        || confess "You must supply the package_name and name parameters";
-
-    # return the new object
-    my $self = $class->meta->new_object(%options);
-    
-    # we don't want this creating
-    # a cycle in the code, if not
-    # needed
-    Scalar::Util::weaken($self->{'$!attribute'});
-
-    $self->initialize_body;  
-    
-    $self;
-});
-
-
 ## --------------------------------------------------------
 ## Class::MOP::Method::Constructor
 
 Class::MOP::Method::Constructor->meta->add_attribute(
-    Class::MOP::Attribute->new('%!options' => (
-        init_arg => 'options',
+    Class::MOP::Attribute->new('options' => (
         reader   => {
             'options' => \&Class::MOP::Method::Constructor::options
         },
@@ -674,38 +630,14 @@ Class::MOP::Method::Constructor->meta->add_attribute(
 );
 
 Class::MOP::Method::Constructor->meta->add_attribute(
-    Class::MOP::Attribute->new('$!associated_metaclass' => (
-        init_arg => 'metaclass',
+    Class::MOP::Attribute->new('associated_metaclass' => (
+        init_arg => "metaclass", # FIXME alias and rename
         reader   => {
             'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
         },
     ))
 );
 
-Class::MOP::Method::Constructor->meta->add_method('new' => sub {
-    my $class   = shift;
-    my %options = @_;
-
-    (Scalar::Util::blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class'))
-        || confess "You must pass a metaclass instance if you want to inline"
-            if $options{is_inline};
-
-    ($options{package_name} && $options{name})
-        || confess "You must supply the package_name and name parameters";
-
-    # return the new object
-    my $self = $class->meta->new_object(%options);
-    
-    # we don't want this creating
-    # a cycle in the code, if not
-    # needed
-    Scalar::Util::weaken($self->{'$!associated_metaclass'});
-
-    $self->initialize_body;  
-    
-    $self;
-});
-
 ## --------------------------------------------------------
 ## Class::MOP::Instance
 
@@ -714,26 +646,57 @@ Class::MOP::Method::Constructor->meta->add_method('new' => sub {
 # included for completeness
 
 Class::MOP::Instance->meta->add_attribute(
-    Class::MOP::Attribute->new('$!meta')
+    Class::MOP::Attribute->new('associated_metaclass',
+        reader   => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
+    ),
+);
+
+Class::MOP::Instance->meta->add_attribute(
+    Class::MOP::Attribute->new('_class_name',
+        init_arg => undef,
+        reader   => { _class_name => \&Class::MOP::Instance::_class_name },
+        #lazy     => 1, # not yet supported by Class::MOP but out our version does it anyway
+        #default  => sub { $_[0]->associated_metaclass->name },
+    ),
+);
+
+Class::MOP::Instance->meta->add_attribute(
+    Class::MOP::Attribute->new('attributes',
+        reader   => { attributes => \&Class::MOP::Instance::get_all_attributes },
+    ),
+);
+
+Class::MOP::Instance->meta->add_attribute(
+    Class::MOP::Attribute->new('slots',
+        reader   => { slots => \&Class::MOP::Instance::slots },
+    ),
 );
 
 Class::MOP::Instance->meta->add_attribute(
-    Class::MOP::Attribute->new('@!slots')
+    Class::MOP::Attribute->new('slot_hash',
+        reader   => { slot_hash => \&Class::MOP::Instance::slot_hash },
+    ),
 );
 
+
+# we need the meta instance of the meta instance to be created now, in order
+# for the constructor to be able to use it
+Class::MOP::Instance->meta->get_meta_instance;
+
+# pretend the add_method never happenned. it hasn't yet affected anything
+undef Class::MOP::Instance->meta->{_package_cache_flag};
+
 ## --------------------------------------------------------
 ## Now close all the Class::MOP::* classes
 
-# NOTE:
-# we don't need to inline the
-# constructors or the accessors
-# this only lengthens the compile
-# time of the MOP, and gives us
-# no actual benefits.
+# NOTE: we don't need to inline the the accessors this only lengthens
+# the compile time of the MOP, and gives us no actual benefits.
 
 $_->meta->make_immutable(
-    inline_constructor => 0,
-    inline_accessors   => 0,
+    inline_constructor  => 1,
+    replace_constructor => 1,
+    constructor_name    => "_new",
+    inline_accessors => 0,
 ) for qw/
     Class::MOP::Package
     Class::MOP::Module
@@ -947,10 +910,21 @@ We set this constant depending on what version perl we are on, this
 allows us to take advantage of new 5.10 features and stay backwards 
 compat.
 
+=item I<HAVE_ISAREV>
+
+Whether or not C<mro> provides C<get_isarev>, a much faster way to get all the
+subclasses of a certain class.
+
+=item I<USING_XS>
+
+Whether or not the running C<Class::MOP> is using its XS version.
+
 =back
 
 =head2 Utility functions
 
+Note that these are all called as B<functions, not methods>.
+
 =over 4
 
 =item B<load_class ($class_name)>
@@ -971,6 +945,8 @@ is probably correct about 99% of the time.
 
 =item B<check_package_cache_flag ($pkg)>
 
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
 This will return an integer that is managed by C<Class::MOP::Class>
 to determine if a module's symbol table has been altered. 
 
@@ -980,6 +956,8 @@ which is not package specific.
 
 =item B<get_code_info ($code)>
 
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
 This function returns two values, the name of the package the C<$code> 
 is from and the name of the C<$code> itself. This is used by several 
 elements of the MOP to detemine where a given C<$code> reference is from.
@@ -992,36 +970,55 @@ If possible, we will load the L<Sub::Name> module and this will function
 as C<Sub::Name::subname> does, otherwise it will just return the C<$code>
 argument.
 
+=item B<in_global_destruction>
+
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
+If L<Devel::GlobalDestruction> is available, this returns true under global
+destruction.
+
+Otherwise it's a constant returning false.
+
+=item B<load_first_existing_class ($class_name, [$class_name, ...])>
+
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
+Given a list of class names, this function will attempt to load each
+one in turn.
+
+If it finds a class it can load, it will return that class' name.
+If none of the classes can be loaded, it will throw an exception.
+
 =back
 
 =head2 Metaclass cache functions
 
-Class::MOP holds a cache of metaclasses, the following are functions
+Class::MOP holds a cache of metaclasses. The following are functions
 (B<not methods>) which can be used to access that cache. It is not
-recommended that you mess with this, bad things could happen. But if
-you are brave and willing to risk it, go for it.
+recommended that you mess with these. Bad things could happen, but if
+you are brave and willing to risk it: go for it!
 
 =over 4
 
 =item B<get_all_metaclasses>
 
-This will return an hash of all the metaclass instances that have
-been cached by B<Class::MOP::Class> keyed by the package name.
+This will return a hash of all the metaclass instances that have
+been cached by B<Class::MOP::Class>, keyed by the package name.
 
 =item B<get_all_metaclass_instances>
 
-This will return an array of all the metaclass instances that have
+This will return a list of all the metaclass instances that have
 been cached by B<Class::MOP::Class>.
 
 =item B<get_all_metaclass_names>
 
-This will return an array of all the metaclass names that have
+This will return a list of all the metaclass names that have
 been cached by B<Class::MOP::Class>.
 
 =item B<get_metaclass_by_name ($name)>
 
-This will return a cached B<Class::MOP::Class> instance of nothing
-if no metaclass exist by that C<$name>.
+This will return a cached B<Class::MOP::Class> instance, or nothing
+if no metaclass exists with that C<$name>.
 
 =item B<store_metaclass_by_name ($name, $meta)>
 
@@ -1029,18 +1026,19 @@ This will store a metaclass in the cache at the supplied C<$key>.
 
 =item B<weaken_metaclass ($name)>
 
-In rare cases it is desireable to store a weakened reference in 
-the metaclass cache. This function will weaken the reference to 
-the metaclass stored in C<$name>.
+In rare cases (e.g. anonymous metaclasses) it is desirable to
+store a weakened reference in the metaclass cache. This
+function will weaken the reference to the metaclass stored
+in C<$name>.
 
 =item B<does_metaclass_exist ($name)>
 
 This will return true of there exists a metaclass stored in the 
-C<$name> key and return false otherwise.
+C<$name> key, and return false otherwise.
 
 =item B<remove_metaclass_by_name ($name)>
 
-This will remove a the metaclass stored in the C<$name> key.
+This will remove the metaclass stored in the C<$name> key.
 
 =back
 
@@ -1147,6 +1145,8 @@ B<with contributions from:>
 
 Brandon (blblack) Black
 
+Florian (rafl) Ragwitz
+
 Guillermo (groditi) Roditi
 
 Matt (mst) Trout