X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=6902284f53ca9421eaef469399a75435886b7934;hb=864826055ffa48aba41ba1a016c09f24b51e85c4;hp=c0bebc4e9917d396e94d289ae323e62beb7baed6;hpb=2d711cc8f03b6d8cbfe53f9628883ff33582ed03;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index c0bebc4..6902284 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -5,11 +5,14 @@ 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.14';
+our $VERSION   = '0.20';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Module';
 
 use Class::MOP::Instance;
 
@@ -18,103 +21,214 @@ use Class::MOP::Instance;
 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, 
+            
+            # 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,                
+            # inherited from Class::MOP::Module
+            '$:version'             => \undef,
+            '$:authority'           => \undef,
+            # defined in Class::MOP::Class
+            
+            '%:methods'             => {},
+            '%: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";  
+    else {
         # 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',
-                '$:instance_metaclass'  => $options{':instance_metaclass'}  || 'Class::MOP::Instance',    
-            } => $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;
+        # 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) . ")";                           
+    }        
+} 
+
+## ANON classes
+
+{
+    # 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::';    
 
-        # this is always okay ...
-        return if blessed($self) eq 'Class::MOP::Class';
+    sub is_anon_class {
+        my $self = shift;
+        $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;        
+    }
 
-        my @class_list = $self->class_precedence_list;
-        shift @class_list; # shift off $self->name
+    sub create_anon_class {
+        my ($class, %options) = @_;   
+        my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
+        return $class->create($package_name, %options);
+    } 
 
-        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)) . ")";
-        }        
+    # 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) = @_;
+    my $class        = shift;
+    my $package_name = shift;
+    
     (defined $package_name && $package_name)
         || confess "You must pass a package name";
+
+    (scalar @_ % 2 == 0)
+        || confess "You much pass all parameters as name => value pairs " . 
+                   "(I found an uneven number of params in \@_)";
+
+    my (%options) = @_;
+    
     my $code = "package $package_name;";
-    $code .= "\$$package_name\:\:VERSION = '$package_version';" 
-        if defined $package_version;
+    $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';" 
+        if exists $options{version};
+    $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';" 
+        if exists $options{authority};  
+              
     eval $code;
     confess "creation of $package_name failed : $@" if $@;    
+    
     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}})
@@ -137,32 +251,41 @@ 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'}  }
 
+# FIXME:
+# this is a prime canidate for conversion to XS
+sub get_method_map {    
+    my $self = shift;
+    my $map  = $self->{'%:methods'}; 
+    
+    my $class_name       = $self->name;
+    my $method_metaclass = $self->method_metaclass;
+    
+    foreach my $symbol ($self->list_all_package_symbols('CODE')) {
+        my $code = $self->get_package_symbol('&' . $symbol);
+        
+        next if exists $map->{$symbol} && $map->{$symbol}->body == $code;        
+        
+        my $gv = svref_2object($code)->GV;
+        next if ($gv->STASH->NAME || '') ne $class_name &&
+                ($gv->NAME        || '') ne '__ANON__';        
+        
+        $map->{$symbol} = $method_metaclass->wrap($code);
+    }
+    
+    return $map;
+}
+
 # Instance Construction & Cloning
 
 sub new_object {
@@ -179,19 +302,20 @@ sub new_object {
 
 sub construct_instance {
     my ($class, %params) = @_;
-    
-    my $instance = $class->get_meta_instance->create_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($instance, \%params);
+        $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
     return $instance;
 }
 
 sub get_meta_instance {
     my $class = shift;
-    # make it work,.. *then* make it right ... # yeah that was my plan, i just thought we'll make it async
-    $class->{meta_instance} ||= $class->instance_metaclass->new( $class );
+    return $class->instance_metaclass->new(
+        $class, 
+        $class->compute_all_applicable_attributes()
+    );
 }
 
 sub clone_object {
@@ -204,37 +328,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 {
@@ -249,11 +374,7 @@ sub class_precedence_list {
     (
         $self->name, 
         map { 
-            # OPTIMIZATION NOTE:
-            # we grab the metaclass from the %METAS 
-            # hash here to save the initialize() call
-            # if we can, but it is not always possible            
-            ($METAS{$_} || $self->initialize($_))->class_precedence_list()
+            $self->initialize($_)->class_precedence_list()
         } $self->superclasses()
     );   
 }
@@ -264,16 +385,21 @@ sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-    # 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);
     
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = subname $full_method_name => $method;
+    my $body;
+    if (blessed($method)) {
+        $body = $method->body;           
+    }
+    else {        
+        $body = $method;
+        ('CODE' eq (reftype($body) || ''))
+            || confess "Your code block must be a CODE reference";        
+        $method = $self->method_metaclass->wrap($body);        
+    }
+    $self->get_method_map->{$method_name} = $method;
+    
+    my $full_method_name = ($self->name . '::' . $method_name);        
+    $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
 }
 
 {
@@ -283,23 +409,22 @@ sub add_method {
         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))
+            # 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";
-            # 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')) {
+            # 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);
-            $self->add_method($method_name => $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;
     };
 
@@ -345,34 +470,20 @@ sub alias_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-    # 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);    
+    my $body = (blessed($method) ? $method->body : $method);
+    ('CODE' eq (reftype($body) || ''))
+        || confess "Your code block must be a CODE reference";        
         
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = $method;
+    $self->add_package_symbol("&${method_name}" => $body);
 }
 
 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 (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);
+    return 0 unless exists $self->get_method_map->{$method_name};    
     return 1;
 }
 
@@ -380,11 +491,14 @@ sub get_method {
     my ($self, $method_name) = @_;
     (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};
+     
+    # NOTE:
+    # I don't really need this here, because
+    # if the method_map is missing a key it 
+    # will just return undef for me now
+    # return unless $self->has_method($method_name);
+ 
+    return $self->get_method_map->{$method_name};
 }
 
 sub remove_method {
@@ -394,17 +508,23 @@ sub remove_method {
     
     my $removed_method = $self->get_method($method_name);    
     
-    no strict 'refs';
-    delete ${$self->name . '::'}{$method_name}
-        if defined $removed_method;
+    do { 
+        $self->remove_package_symbol("&${method_name}");
+        delete $self->get_method_map->{$method_name};
+    } if defined $removed_method;
         
     return $removed_method;
 }
 
 sub get_method_list {
     my $self = shift;
-    no strict 'refs';
-    grep { $self->has_method($_) } %{$self->name . '::'};
+    keys %{$self->get_method_map};
+}
+
+sub find_method_by_name {
+    my ($self, $method_name) = @_;
+    # FIXME
+    return $self->name->can($method_name);
 }
 
 sub compute_all_applicable_methods {
@@ -489,10 +609,21 @@ sub add_attribute {
     # make sure it is derived from the correct type though
     ($attribute->isa('Class::MOP::Attribute'))
         || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";    
+
+    # first we attach our new attribute
+    # because it might need certain information 
+    # about the class which it is attached to
     $attribute->attach_to_class($self);
+    
+    # then we remove attributes of a conflicting 
+    # name here so that we can properly detach 
+    # the old attr object, and remove any 
+    # accessors it would have generated
+    $self->remove_attribute($attribute->name)
+        if $self->has_attribute($attribute->name);
+        
+    # then onto installing the new accessors
     $attribute->install_accessors();
-    $attribute->allocate_slots;
-
     $self->get_attribute_map->{$attribute->name} = $attribute;
 }
 
@@ -507,13 +638,11 @@ sub get_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    # OPTIMIZATION NOTE:
-    # we used to say `if $self->has_attribute($attribute_name)` 
-    # here, but since get_attribute is called so often, we 
-    # eliminate the function call here
-    return $self->{'%:attributes'}->{$attribute_name} 
-        if exists $self->{'%:attributes'}->{$attribute_name};   
-    return; 
+    return $self->get_attribute_map->{$attribute_name} 
+    # NOTE:
+    # this will return undef anyway, so no need ...
+    #    if $self->has_attribute($attribute_name);   
+    #return; 
 } 
 
 sub remove_attribute {
@@ -524,19 +653,13 @@ sub remove_attribute {
     return unless defined $removed_attribute;
     delete $self->get_attribute_map->{$attribute_name};        
     $removed_attribute->remove_accessors(); 
-    $removed_attribute->deallocate_slots();
     $removed_attribute->detach_from_class();
     return $removed_attribute;
 } 
 
 sub get_attribute_list {
     my $self = shift;
-    # OPTIMIZATION NOTE:
-    # We don't use get_attribute_map here because 
-    # we ask for the attribute list quite often 
-    # in compute_all_applicable_attributes, so 
-    # eliminating the function call helps 
-    keys %{$self->{'%:attributes'}};
+    keys %{$self->get_attribute_map};
 } 
 
 sub compute_all_applicable_attributes {
@@ -551,10 +674,7 @@ sub compute_all_applicable_attributes {
         next if $seen_class{$class};
         $seen_class{$class}++;
         # fetch the meta-class ...
-        # OPTIMIZATION NOTE:
-        # we grab the metaclass from the %METAS 
-        # hash here to save the initialize() call
-        my $meta = $METAS{$class};
+        my $meta = $self->initialize($class);
         foreach my $attr_name ($meta->get_attribute_list()) { 
             next if exists $seen_attr{$attr_name};
             $seen_attr{$attr_name}++;
@@ -582,69 +702,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 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 is_mutable   { 1 }
+sub is_immutable { 0 }
 
-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;
@@ -676,7 +740,8 @@ Class::MOP::Class - Class Meta Object
   
   # or use this to actually create classes ...
   
-  Class::MOP::Class->create('Bar' => '0.01' => (
+  Class::MOP::Class->create('Bar' => (
+      version      => '0.01',
       superclasses => [ 'Foo' ],
       attributes => [
           Class::MOP:::Attribute->new('$bar'),
@@ -713,21 +778,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
@@ -742,15 +792,17 @@ created any more than nessecary. Basically, they are singletons.
 
 =over 4
 
-=item B<create ($package_name, ?$package_version,
+=item B<create ($package_name, 
+                version      =E<gt> ?$version,                 
+                authority    =E<gt> ?$authority,                                 
                 superclasses =E<gt> ?@superclasses, 
                 methods      =E<gt> ?%methods, 
                 attributes   =E<gt> ?%attributes)>
 
 This returns a B<Class::MOP::Class> object, bringing the specified 
-C<$package_name> into existence and adding any of the 
-C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes> 
-to it.
+C<$package_name> into existence and adding any of the C<$version>, 
+C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to 
+it.
 
 =item B<create_anon_class (superclasses =E<gt> ?@superclasses, 
                            methods      =E<gt> ?%methods, 
@@ -760,11 +812,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 
@@ -859,17 +917,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
 
@@ -902,6 +958,8 @@ what B<Class::ISA::super_path> does, but we don't remove duplicate names.
 
 =over 4
 
+=item B<get_method_map>
+
 =item B<method_metaclass>
 
 =item B<add_method ($method_name, $method)>
@@ -951,9 +1009,19 @@ C<$method_name> is actually a method. However, it will DWIM about
 
 =item B<get_method ($method_name)>
 
-This will return a CODE reference of the specified C<$method_name>, 
+This will return a Class::MOP::Method instance related to the specified 
+C<$method_name>, or return undef if that method does not exist.
+
+The Class::MOP::Method is codifiable, so you can use it like a normal 
+CODE reference, see L<Class::MOP::Method> for more information.
+
+=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. 
@@ -1123,6 +1191,11 @@ It should be noted that any accessor, reader/writer or predicate
 methods which the C<$attribute_meta_object> has will be installed 
 into the class at this time.
 
+B<NOTE>
+If an attribute already exists for C<$attribute_name>, the old one 
+will be removed (as well as removing all it's accessors), and then 
+the new one added.
+
 =item B<has_attribute ($attribute_name)>
 
 Checks to see if this class has an attribute by the name of 
@@ -1172,43 +1245,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.
@@ -1218,4 +1268,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. 
 
-=cutchistian
\ No newline at end of file
+=cut