X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=aca8a507231afbbf46f4a4b33e402055e3e2d28d;hb=b9d9fc0b01c940ad89c092eaf01e67c23b6036d5;hp=9c5cd8461207383135eacc60bb66164b12c2003a;hpb=37f36b2ad0bca80a86767b35c7267654b2d97ec7;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 9c5cd84..aca8a50 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -5,100 +5,193 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.12';
+our $VERSION   = '0.18';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Module';
+
+use Class::MOP::Instance;
 
 # Self-introspection 
 
 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
 
 # Creation
-
-{
-    # Metaclasses are singletons, so we cache them here.
-    # there is no need to worry about destruction though
-    # because they should die only when the program dies.
-    # After all, do package definitions even get reaped?
-    my %METAS;  
     
-    # means of accessing all the metaclasses that have 
-    # been initialized thus far (for mugwumps obj browser)
-    sub get_all_metaclasses         {        %METAS }            
-    sub get_all_metaclass_instances { values %METAS } 
-    sub get_all_metaclass_names     { keys   %METAS }     
+sub initialize {
+    my $class        = shift;
+    my $package_name = shift;
+    (defined $package_name && $package_name && !blessed($package_name))
+        || confess "You must pass a package name and it cannot be blessed";    
+    $class->construct_class_instance(':package' => $package_name, @_);
+}
+
+sub reinitialize {
+    my $class        = shift;
+    my $package_name = shift;
+    (defined $package_name && $package_name && !blessed($package_name))
+        || confess "You must pass a package name and it cannot be blessed";    
+    Class::MOP::remove_metaclass_by_name($package_name);
+    $class->construct_class_instance(':package' => $package_name, @_);
+}       
     
-    sub initialize {
-        my $class        = shift;
-        my $package_name = shift;
-        (defined $package_name && $package_name && !blessed($package_name))
-            || confess "You must pass a package name and it cannot be blessed";    
-        $class->construct_class_instance(':package' => $package_name, @_);
+# 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      = @_;
+    my $package_name = $options{':package'};
+    (defined $package_name && $package_name)
+        || confess "You must pass a package name";  
+    # 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)
+    return Class::MOP::get_metaclass_by_name($package_name)
+        if Class::MOP::does_metaclass_exist($package_name);  
+
+    # NOTE:
+    # we need to deal with the possibility 
+    # of class immutability here, and then 
+    # get the name of the class appropriately
+    $class = (blessed($class)
+                    ? ($class->is_immutable
+                        ? $class->get_mutable_metaclass_name()
+                        : blessed($class))
+                    : $class);
+
+    $class = blessed($class) || $class;
+    # now create the metaclass
+    my $meta;
+    if ($class =~ /^Class::MOP::Class$/) {
+        no strict 'refs';                
+        $meta = bless { 
+            # inherited from Class::MOP::Package
+            '$:package'             => $package_name, 
+            '%:namespace'           => \%{$package_name . '::'},                
+            # inherited from Class::MOP::Module
+            '$:version'             => (exists ${$package_name . '::'}{'VERSION'}   ? ${$package_name . '::VERSION'}   : undef),
+            '$:authority'           => (exists ${$package_name . '::'}{'AUTHORITY'} ? ${$package_name . '::AUTHORITY'} : undef),
+            # defined here ...
+            '%:attributes'          => {},
+            '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
+            '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',
+            '$:instance_metaclass'  => $options{':instance_metaclass'}  || 'Class::MOP::Instance',
+        } => $class;
     }
-    
-    # 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      = @_;
-        my $package_name = $options{':package'};
-        (defined $package_name && $package_name)
-            || confess "You must pass a package name";  
-		# 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)
-        return $METAS{$package_name} 
-			if exists $METAS{$package_name} && defined $METAS{$package_name};  
-        $class = blessed($class) || $class;
-        # now create the metaclass
-        my $meta;
-        if ($class =~ /^Class::MOP::/) {    
-            $meta = bless { 
-                '$:package'             => $package_name, 
-                '%:attributes'          => {},
-                '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
-                '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',                
-            } => $class;
-        }
-        else {
-            # NOTE:
-            # it is safe to use meta here because
-            # class will always be a subclass of 
-            # Class::MOP::Class, which defines meta
-            $meta = bless $class->meta->construct_instance(%options) => $class
-        }
-        # and check the metaclass compatibility
-        $meta->check_metaclass_compatability();
-        $METAS{$package_name} = $meta;
+    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)
     }
     
-    sub check_metaclass_compatability {
-        my $self = shift;
+    # and check the metaclass compatibility
+    $meta->check_metaclass_compatability();
+    
+    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 $meta->is_anon_class;
+    
+    $meta;        
+} 
+    
+sub check_metaclass_compatability {
+    my $self = shift;
+
+    # this is always okay ...
+    return if blessed($self)            eq 'Class::MOP::Class'   && 
+              $self->instance_metaclass eq 'Class::MOP::Instance';
+
+    my @class_list = $self->class_precedence_list;
+    shift @class_list; # shift off $self->name
+
+    foreach my $class_name (@class_list) { 
+        my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
+        
+        # NOTE:
+        # we need to deal with the possibility 
+        # of class immutability here, and then 
+        # get the name of the class appropriately            
+        my $meta_type = ($meta->is_immutable
+                            ? $meta->get_mutable_metaclass_name()
+                            : blessed($meta));                
+                            
+        ($self->isa($meta_type))
+            || confess $self->name . "->meta => (" . (blessed($self)) . ")" . 
+                       " is not compatible with the " . 
+                       $class_name . "->meta => (" . ($meta_type)     . ")";
+        # NOTE:
+        # we also need to check that instance metaclasses
+        # are compatabile in the same the class.
+        ($self->instance_metaclass->isa($meta->instance_metaclass))
+            || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" . 
+                       " is not compatible with the " . 
+                       $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";                           
+    }        
+} 
 
-        # this is always okay ...
-        return if blessed($self) eq 'Class::MOP::Class';
+## ANON classes
 
-        my @class_list = $self->class_precedence_list;
-        shift @class_list; # shift off $self->name
+{
+    # NOTE:
+    # this should be sufficient, if you have a 
+    # use case where it is not, write a test and 
+    # I will change it.
+    my $ANON_CLASS_SERIAL = 0;
+    
+    # NOTE:
+    # we need a sufficiently annoying prefix
+    # this should suffice for now, this is 
+    # used in a couple of places below, so 
+    # need to put it up here for now.
+    my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';    
 
-        foreach my $class_name (@class_list) { 
-            my $meta = $METAS{$class_name} || next;
-            ($self->isa(blessed($meta)))
-                || confess $self->name . "->meta => (" . (blessed($self)) . ")" . 
-                           " is not compatible with the " . 
-                           $class_name . "->meta => (" . (blessed($meta)) . ")";
-        }        
+    sub is_anon_class {
+        my $self = shift;
+        $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;        
+    }
+
+    sub create_anon_class {
+        my ($class, %options) = @_;   
+        my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
+        return $class->create($package_name, '0.00', %options);
+    } 
+
+    # NOTE:
+    # this will only get called for 
+    # anon-classes, all other calls 
+    # are assumed to occur during 
+    # global destruction and so don't
+    # really need to be handled explicitly
+    sub DESTROY {
+        my $self = shift;
+        return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
+        my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
+        no strict 'refs';     
+        foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
+            delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
+        }
+        delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};        
     }
+
 }
 
+# creating classes with MOP ...
+
 sub create {
     my ($class, $package_name, $package_version, %options) = @_;
     (defined $package_name && $package_name)
@@ -111,7 +204,7 @@ sub create {
     my $meta = $class->initialize($package_name);
     
     $meta->add_method('meta' => sub { 
-        Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
+        $class->initialize(blessed($_[0]) || $_[0]);
     });
     
     $meta->superclasses(@{$options{superclasses}})
@@ -134,30 +227,16 @@ sub create {
     return $meta;
 }
 
-{
-    # NOTE:
-    # this should be sufficient, if you have a 
-    # use case where it is not, write a test and 
-    # I will change it.
-    my $ANON_CLASS_SERIAL = 0;
-    
-    sub create_anon_class {
-        my ($class, %options) = @_;   
-        my $package_name = 'Class::MOP::Class::__ANON__::SERIAL::' . ++$ANON_CLASS_SERIAL;
-        return $class->create($package_name, '0.00', %options);
-    }
-}
-
 ## Attribute readers
 
 # NOTE:
 # all these attribute readers will be bootstrapped 
 # away in the Class::MOP bootstrap section
 
-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
 
@@ -170,18 +249,27 @@ sub new_object {
     # which will deal with the singletons
     return $class->construct_class_instance(@_)
         if $class->name->isa('Class::MOP::Class');
-    bless $class->construct_instance(@_) => $class->name;
+    return $class->construct_instance(@_);
 }
 
 sub construct_instance {
     my ($class, %params) = @_;
-    my $instance = {};
+    my $meta_instance = $class->get_meta_instance();
+    my $instance = $meta_instance->create_instance();
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        $attr->initialize_instance_slot($class, $instance, \%params);
+        $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
     return $instance;
 }
 
+sub get_meta_instance {
+    my $class = shift;
+    return $class->instance_metaclass->new(
+        $class, 
+        $class->compute_all_applicable_attributes()
+    );
+}
+
 sub clone_object {
     my $class    = shift;
     my $instance = shift; 
@@ -192,37 +280,38 @@ sub clone_object {
     # Class::MOP::Class singletons here, they 
     # should not be cloned.
     return $instance if $instance->isa('Class::MOP::Class');   
-    bless $class->clone_instance($instance, @_) => blessed($instance);
+    $class->clone_instance($instance, @_);
 }
 
 sub clone_instance {
     my ($class, $instance, %params) = @_;
     (blessed($instance))
         || confess "You can only clone instances, \$self is not a blessed instance";
-    my $clone = { %$instance, %params }; 
+    my $meta_instance = $class->get_meta_instance();
+    my $clone = $meta_instance->clone_instance($instance);        
+    foreach my $key (keys %params) {
+        next unless $meta_instance->is_valid_slot($key);
+        $meta_instance->set_slot_value($clone, $key, $params{$key});
+    }
     return $clone;    
 }
 
-# Informational 
-
-# &name should be here too, but it is above
-# because it gets bootstrapped away
-
-sub version {  
-    my $self = shift;
-    ${$self->get_package_variable('$VERSION')};
-}
-
 # Inheritance
 
 sub superclasses {
     my $self = shift;
-    no strict 'refs';
     if (@_) {
         my @supers = @_;
-        @{$self->name . '::ISA'} = @supers;
+        @{$self->get_package_symbol('@ISA')} = @supers;
+        # NOTE:
+        # we need to check the metaclass 
+        # compatability here so that we can 
+        # be sure that the superclass is 
+        # not potentially creating an issues 
+        # we don't know about
+        $self->check_metaclass_compatability();
     }
-    @{$self->name . '::ISA'};
+    @{$self->get_package_symbol('@ISA')};
 }
 
 sub class_precedence_list {
@@ -232,7 +321,7 @@ sub class_precedence_list {
     # This will do nothing if all is well, and blow
     # up otherwise. Yes, it's an ugly hack, better 
     # suggestions are welcome.
-    { $self->name->isa('This is a test for circular inheritance') }
+    { ($self->name || return)->isa('This is a test for circular inheritance') }
     # ... and now back to our regularly scheduled program
     (
         $self->name, 
@@ -253,63 +342,62 @@ sub add_method {
         || confess "Your code block must be a CODE reference";
     my $full_method_name = ($self->name . '::' . $method_name);    
 
-	$method = $self->method_metaclass->wrap($method) unless blessed($method);
-	
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = subname $full_method_name => $method;
+    # FIXME:
+    # dont bless subs, its bad mkay
+    $method = $self->method_metaclass->wrap($method) unless blessed($method);
+    
+    $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
 }
 
 {
-	my $fetch_and_prepare_method = sub {
-		my ($self, $method_name) = @_;
-		# fetch it locally
-		my $method = $self->get_method($method_name);
-		# if we dont have local ...
-		unless ($method) {
-			# make sure this method even exists ...
-			($self->find_next_method_by_name($method_name))
-				|| confess "The method '$method_name' is not found in the inherience hierarchy for this class";
-			# if so, then create a local which just 
-			# calls the next applicable method ...				
-			$self->add_method($method_name => sub {
-				$self->find_next_method_by_name($method_name)->(@_);
-			});
-			$method = $self->get_method($method_name);
-		}
-		
-		# now make sure we wrap it properly 
-		# (if it isnt already)
-		unless ($method->isa('Class::MOP::Method::Wrapped')) {
-			$method = Class::MOP::Method::Wrapped->wrap($method);
-			$self->add_method($method_name => $method);	
-		}		
-		return $method;
-	};
-
-	sub add_before_method_modifier {
-		my ($self, $method_name, $method_modifier) = @_;
-	    (defined $method_name && $method_name)
-	        || confess "You must pass in a method name";	
-		my $method = $fetch_and_prepare_method->($self, $method_name);
-		$method->add_before_modifier(subname ':before' => $method_modifier);
-	}
-
-	sub add_after_method_modifier {
-		my ($self, $method_name, $method_modifier) = @_;
-	    (defined $method_name && $method_name)
-	        || confess "You must pass in a method name";	
-		my $method = $fetch_and_prepare_method->($self, $method_name);
-		$method->add_after_modifier(subname ':after' => $method_modifier);
-	}
-	
-	sub add_around_method_modifier {
-		my ($self, $method_name, $method_modifier) = @_;
-	    (defined $method_name && $method_name)
-	        || confess "You must pass in a method name";
-		my $method = $fetch_and_prepare_method->($self, $method_name);
-		$method->add_around_modifier(subname ':around' => $method_modifier);
-	}	
+    my $fetch_and_prepare_method = sub {
+        my ($self, $method_name) = @_;
+        # fetch it locally
+        my $method = $self->get_method($method_name);
+        # if we dont 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)
+                || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
+            # and now make sure to wrap it 
+            # even if it is already wrapped
+            # because we need a new sub ref
+            $method = Class::MOP::Method::Wrapped->wrap($method);
+        }
+        else {
+            # now make sure we wrap it properly 
+            $method = Class::MOP::Method::Wrapped->wrap($method)
+                unless $method->isa('Class::MOP::Method::Wrapped');  
+        }    
+        $self->add_method($method_name => $method);        
+        return $method;
+    };
+
+    sub add_before_method_modifier {
+        my ($self, $method_name, $method_modifier) = @_;
+        (defined $method_name && $method_name)
+            || confess "You must pass in a method name";    
+        my $method = $fetch_and_prepare_method->($self, $method_name);
+        $method->add_before_modifier(subname ':before' => $method_modifier);
+    }
+
+    sub add_after_method_modifier {
+        my ($self, $method_name, $method_modifier) = @_;
+        (defined $method_name && $method_name)
+            || confess "You must pass in a method name";    
+        my $method = $fetch_and_prepare_method->($self, $method_name);
+        $method->add_after_modifier(subname ':after' => $method_modifier);
+    }
+    
+    sub add_around_method_modifier {
+        my ($self, $method_name, $method_modifier) = @_;
+        (defined $method_name && $method_name)
+            || confess "You must pass in a method name";
+        my $method = $fetch_and_prepare_method->($self, $method_name);
+        $method->add_around_modifier(subname ':around' => $method_modifier);
+    }   
 
     # NOTE: 
     # the methods above used to be named like this:
@@ -332,31 +420,33 @@ sub alias_method {
     # use reftype here to allow for blessed subs ...
     ('CODE' eq (reftype($method) || ''))
         || confess "Your code block must be a CODE reference";
-    my $full_method_name = ($self->name . '::' . $method_name);
 
-	$method = $self->method_metaclass->wrap($method) unless blessed($method);    
+    # FIXME:
+    # dont bless subs, its bad mkay
+    $method = $self->method_metaclass->wrap($method) unless blessed($method);    
         
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = $method;
+    $self->add_package_symbol("&${method_name}" => $method);
+}
+
+sub find_method_by_name {
+    my ($self, $method_name) = @_;
+    return $self->name->can($method_name);
 }
 
 sub has_method {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";    
-
-    my $sub_name = ($self->name . '::' . $method_name);   
     
-    no strict 'refs';
-    return 0 if !defined(&{$sub_name});        
-	my $method = \&{$sub_name};
+    return 0 if !$self->has_package_symbol("&${method_name}");        
+    my $method = $self->get_package_symbol("&${method_name}");
     return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
-                (svref_2object($method)->GV->NAME || '')        ne '__ANON__';		
-	
-	# at this point we are relatively sure 
-	# it is our method, so we bless/wrap it 
-	$self->method_metaclass->wrap($method) unless blessed($method);
+                (svref_2object($method)->GV->NAME || '')        ne '__ANON__';      
+
+    # FIXME:
+    # dont bless subs, its bad mkay
+    $self->method_metaclass->wrap($method) unless blessed($method);
+    
     return 1;
 }
 
@@ -365,10 +455,9 @@ sub get_method {
     (defined $method_name && $method_name)
         || confess "You must define a method name";
 
-	return unless $self->has_method($method_name);
-
-    no strict 'refs';    
-    return \&{$self->name . '::' . $method_name};
+    return unless $self->has_method($method_name);
+ 
+    return $self->get_package_symbol("&${method_name}");
 }
 
 sub remove_method {
@@ -378,8 +467,7 @@ sub remove_method {
     
     my $removed_method = $self->get_method($method_name);    
     
-    no strict 'refs';
-    delete ${$self->name . '::'}{$method_name}
+    $self->remove_package_symbol("&${method_name}")
         if defined $removed_method;
         
     return $removed_method;
@@ -387,8 +475,7 @@ sub remove_method {
 
 sub get_method_list {
     my $self = shift;
-    no strict 'refs';
-    grep { $self->has_method($_) } %{$self->name . '::'};
+    grep { $self->has_method($_) } $self->list_all_package_symbols;
 }
 
 sub compute_all_applicable_methods {
@@ -444,23 +531,23 @@ sub find_all_methods_by_name {
 sub find_next_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name to find";	
+        || confess "You must define a method name to find"; 
     # keep a record of what we have seen
     # here, this will handle all the 
     # inheritence issues because we are 
     # using the &class_precedence_list
     my %seen_class;
-	my @cpl = $self->class_precedence_list();
-	shift @cpl; # discard ourselves
+    my @cpl = $self->class_precedence_list();
+    shift @cpl; # discard ourselves
     foreach my $class (@cpl) {
         next if $seen_class{$class};
         $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
-		return $meta->get_method($method_name) 
-			if $meta->has_method($method_name);
+        return $meta->get_method($method_name) 
+            if $meta->has_method($method_name);
     }
-	return;
+    return;
 }
 
 ## Attributes
@@ -474,22 +561,22 @@ sub add_attribute {
     ($attribute->isa('Class::MOP::Attribute'))
         || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";    
     $attribute->attach_to_class($self);
-    $attribute->install_accessors();        
-    $self->{'%:attributes'}->{$attribute->name} = $attribute;
+    $attribute->install_accessors();
+    $self->get_attribute_map->{$attribute->name} = $attribute;
 }
 
 sub has_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    exists $self->{'%:attributes'}->{$attribute_name} ? 1 : 0;    
+    exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;    
 } 
 
 sub get_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    return $self->{'%:attributes'}->{$attribute_name} 
+    return $self->get_attribute_map->{$attribute_name} 
         if $self->has_attribute($attribute_name);   
     return; 
 } 
@@ -501,14 +588,14 @@ sub remove_attribute {
     my $removed_attribute = $self->get_attribute_map->{$attribute_name};    
     return unless defined $removed_attribute;
     delete $self->get_attribute_map->{$attribute_name};        
-    $removed_attribute->remove_accessors();        
-    $removed_attribute->detach_from_class();    
+    $removed_attribute->remove_accessors(); 
+    $removed_attribute->detach_from_class();
     return $removed_attribute;
 } 
 
 sub get_attribute_list {
     my $self = shift;
-    keys %{$self->{'%:attributes'}};
+    keys %{$self->get_attribute_map};
 } 
 
 sub compute_all_applicable_attributes {
@@ -551,69 +638,13 @@ sub find_attribute_by_name {
     return;
 }
 
-# Class attributes
+## Class closing
 
-sub add_package_variable {
-    my ($self, $variable, $initial_value) = @_;
-    (defined $variable && $variable =~ /^[\$\@\%]/)
-        || confess "variable name does not have a sigil";
-    
-    my ($sigil, $name) = ($variable =~ /^(.)(.*)$/); 
-    if (defined $initial_value) {
-        no strict 'refs';
-        *{$self->name . '::' . $name} = $initial_value;
-    }
-    else {
-        my $e;
-        {        
-            # NOTE:
-            # We HAVE to localize $@ or all 
-            # hell breaks loose. It is not 
-            # good, believe me, not good.
-            local $@;
-            eval $sigil . $self->name . '::' . $name;
-            $e = $@ if $@;            
-        }
-        confess "Could not create package variable ($variable) because : $e" if $e;
-    }
-}
+sub is_mutable   { 1 }
+sub is_immutable { 0 }
 
-sub has_package_variable {
-    my ($self, $variable) = @_;
-    (defined $variable && $variable =~ /^[\$\@\%]/)
-        || confess "variable name does not have a sigil";
-    my ($sigil, $name) = ($variable =~ /^(.)(.*)$/); 
-    no strict 'refs';
-    defined ${$self->name . '::'}{$name} ? 1 : 0;
-}
-
-sub get_package_variable {
-    my ($self, $variable) = @_;
-    (defined $variable && $variable =~ /^[\$\@\%]/)
-        || confess "variable name does not have a sigil";
-    my ($sigil, $name) = ($variable =~ /^(.)(.*)$/); 
-    my ($ref, $e);
-    {
-        # NOTE:
-        # We HAVE to localize $@ or all 
-        # hell breaks loose. It is not 
-        # good, believe me, not good.
-        local $@;        
-        $ref = eval '\\' . $sigil . $self->name . '::' . $name;
-        $e = $@ if $@;
-    }
-    confess "Could not get the package variable ($variable) because : $e" if $e;    
-    # if we didn't die, then we can return it
-	return $ref;
-}
-
-sub remove_package_variable {
-    my ($self, $variable) = @_;
-    (defined $variable && $variable =~ /^[\$\@\%]/)
-        || confess "variable name does not have a sigil";
-    my ($sigil, $name) = ($variable =~ /^(.)(.*)$/); 
-    no strict 'refs';
-    delete ${$self->name . '::'}{$name};
+sub make_immutable {
+    return Class::MOP::Class::Immutable->make_metaclass_immutable(@_);
 }
 
 1;
@@ -682,21 +713,6 @@ bootstrap this module by installing a number of attribute meta-objects
 into it's metaclass. This will allow this class to reap all the benifits 
 of the MOP when subclassing it. 
 
-=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. 
-
-=item B<get_all_metaclass_instances>
-
-This will return an array 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 
-been cached by B<Class::MOP::Class>.
-
 =back
 
 =head2 Class construction
@@ -729,11 +745,17 @@ This will create an anonymous class, it works much like C<create> but
 it does not need a C<$package_name>. Instead it will create a suitably 
 unique package name for you to stash things into.
 
-=item B<initialize ($package_name)>
+=item B<initialize ($package_name, %options)>
 
 This initializes and returns returns a B<Class::MOP::Class> object 
 for a given a C<$package_name>.
 
+=item B<reinitialize ($package_name, %options)>
+
+This removes the old metaclass, and creates a new one in it's place.
+Do B<not> use this unless you really know what you are doing, it could 
+very easily make a very large mess of your program. 
+
 =item B<construct_class_instance (%options)>
 
 This will construct an instance of B<Class::MOP::Class>, it is 
@@ -759,6 +781,10 @@ to use them or not.
 
 =over 4
 
+=item B<instance_metaclass>
+
+=item B<get_meta_instance>
+
 =item B<new_object (%params)>
 
 This is a convience method for creating a new object of the class, and 
@@ -824,17 +850,15 @@ is too I<context-specific> to be part of the MOP.
 
 =head2 Informational 
 
-=over 4
+These are a few predicate methods for asking information about the class.
 
-=item B<name>
+=over 4
 
-This is a read-only attribute which returns the package name for the 
-given B<Class::MOP::Class> instance.
+=item B<is_anon_class>
 
-=item B<version>
+=item B<is_mutable>
 
-This is a read-only attribute which returns the C<$VERSION> of the 
-package for the given B<Class::MOP::Class> instance.
+=item B<is_immutable>
 
 =back
 
@@ -919,6 +943,13 @@ C<$method_name> is actually a method. However, it will DWIM about
 This will return a CODE reference of the specified C<$method_name>, 
 or return undef if that method does not exist.
 
+=item B<find_method_by_name ($method_name>
+
+This will return a CODE reference of the specified C<$method_name>,
+or return undef if that method does not exist.
+
+Unlike C<get_method> this will also look in the superclasses.
+
 =item B<remove_method ($method_name)>
 
 This will attempt to remove a given C<$method_name> from the class. 
@@ -1137,43 +1168,20 @@ It will return undef if nothing is found.
 
 =back
 
-=head2 Package Variables
-
-Since Perl's classes are built atop the Perl package system, it is 
-fairly common to use package scoped variables for things like static 
-class variables. The following methods are convience methods for 
-the creation and inspection of package scoped variables.
+=head2 Class closing
 
 =over 4
 
-=item B<add_package_variable ($variable_name, ?$initial_value)>
-
-Given a C<$variable_name>, which must contain a leading sigil, this 
-method will create that variable within the package which houses the 
-class. It also takes an optional C<$initial_value>, which must be a 
-reference of the same type as the sigil of the C<$variable_name> 
-implies.
-
-=item B<get_package_variable ($variable_name)>
-
-This will return a reference to the package variable in 
-C<$variable_name>. 
-
-=item B<has_package_variable ($variable_name)>
-
-Returns true (C<1>) if there is a package variable defined for 
-C<$variable_name>, and false (C<0>) otherwise.
-
-=item B<remove_package_variable ($variable_name)>
-
-This will attempt to remove the package variable at C<$variable_name>.
+=item B<make_immutable>
 
 =back
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006 by Infinity Interactive, Inc.
@@ -1183,4 +1191,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut