instance-protocol

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index b32e02a..5ba6570 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.13';
+our $VERSION = '0.14';
 
 use Class::MOP::Instance;
 
@@ -67,7 +67,8 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
                 '$:package'             => $package_name, 
                 '%:attributes'          => {},
                 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
-                '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',                
+                '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',
+                '$:instance_metaclass'  => $options{':instance_metaclass'}  || 'Class::MOP::Instance',    
             } => $class;
         }
         else {
@@ -160,6 +161,7 @@ sub name                { $_[0]->{'$:package'}             }
 sub get_attribute_map   { $_[0]->{'%:attributes'}          }
 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
 sub method_metaclass    { $_[0]->{'$:method_metaclass'}    }
+sub instance_metaclass  { $_[0]->{'$:instance_metaclass'}  }
 
 # Instance Construction & Cloning
 
@@ -177,7 +179,7 @@ sub new_object {
 
 sub construct_instance {
     my ($class, %params) = @_;
-    my $meta_instance = Class::MOP::Instance->new($class);
+    my $meta_instance = $class->instance_metaclass->new($class);
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         $attr->initialize_instance_slot($class, $meta_instance, \%params);
     }
@@ -777,6 +779,8 @@ to use them or not.
 
 =over 4
 
+=item B<instance_metaclass>
+
 =item B<new_object (%params)>
 
 This is a convience method for creating a new object of the class, and