immutability is good
Stevan Little [Tue, 29 Aug 2006 06:17:41 +0000 (06:17 +0000)]
lib/Class/MOP.pm
lib/Class/MOP/Class/Immutable.pm
lib/Class/MOP/Method.pm

index b7d634c..7e450d7 100644 (file)
@@ -74,7 +74,10 @@ Class::MOP::Package->meta->add_attribute(
             # NOTE: we need to do this in order 
             # for the instance meta-object to 
             # not fall into meta-circular death
-            'name' => sub { (shift)->{'$:package'} }
+            # 
+            # we just alias the original method
+            # rather than re-produce it here            
+            'name' => \&Class::MOP::Package::name
         },
         init_arg => ':package',
     ))
@@ -84,16 +87,9 @@ Class::MOP::Package->meta->add_attribute(
     Class::MOP::Attribute->new('%:namespace' => (
         reader => {
             # NOTE:
-            # because of issues with the Perl API 
-            # to the typeglob in some versions, we 
-            # need to just always grab a new 
-            # reference to the hash here. Ideally 
-            # we could just store a ref and it would
-            # Just Work, but oh well :\
-            'namespace' => sub { 
-                no strict 'refs';
-                \%{$_[0]->name . '::'} 
-            }
+            # we just alias the original method
+            # rather than re-produce it here
+            'namespace' => \&Class::MOP::Package::namespace
         },
         # NOTE:
         # protect this from silliness 
@@ -127,10 +123,10 @@ Class::MOP::Package->meta->add_method('initialize' => sub {
 Class::MOP::Module->meta->add_attribute(
     Class::MOP::Attribute->new('$:version' => (
         reader => {
-            'version' => sub {  
-                my $self = shift;
-                ${$self->get_package_symbol('$VERSION')};
-            }
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here            
+            'version' => \&Class::MOP::Module::version
         },
         # NOTE:
         # protect this from silliness 
@@ -148,10 +144,10 @@ Class::MOP::Module->meta->add_attribute(
 Class::MOP::Module->meta->add_attribute(
     Class::MOP::Attribute->new('$:authority' => (
         reader => {
-            'authority' => sub {  
-                my $self = shift;
-                ${$self->get_package_symbol('$AUTHORITY')};
-            }
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here            
+            'authority' => \&Class::MOP::Module::authority
         },       
         # NOTE:
         # protect this from silliness 
@@ -168,8 +164,11 @@ Class::MOP::Class->meta->add_attribute(
         reader   => {
             # NOTE: we need to do this in order 
             # for the instance meta-object to 
-            # not fall into meta-circular death            
-            'get_attribute_map' => sub { (shift)->{'%:attributes'} }
+            # not fall into meta-circular death       
+            # 
+            # we just alias the original method
+            # rather than re-produce it here                 
+            'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
         },
         init_arg => ':attributes',
         default  => sub { {} }
@@ -179,16 +178,10 @@ Class::MOP::Class->meta->add_attribute(
 Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('%:methods' => (
         reader   => {          
-            'get_method_map' => sub {
-                my $self = shift;
-                my $map  = $self->{'%:methods'}; 
-                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;
-                    $map->{$symbol} = $self->method_metaclass->wrap($code);
-                }
-                return $map;         
-            }
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here            
+            'get_method_map' => \&Class::MOP::Class::get_method_map
         },
         default => sub { {} }
     ))
@@ -215,8 +208,11 @@ Class::MOP::Class->meta->add_attribute(
         reader   => {
             # NOTE: we need to do this in order 
             # for the instance meta-object to 
-            # not fall into meta-circular death            
-            'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} }
+            # not fall into meta-circular death      
+            # 
+            # we just alias the original method
+            # rather than re-produce it here                  
+            'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
         },
         init_arg => ':instance_metaclass',
         default  => 'Class::MOP::Instance',        
@@ -237,8 +233,11 @@ Class::MOP::Attribute->meta->add_attribute(
         reader => {
             # NOTE: we need to do this in order 
             # for the instance meta-object to 
-            # not fall into meta-circular death            
-            'name' => sub { (shift)->{name} }
+            # not fall into meta-circular death    
+            # 
+            # we just alias the original method
+            # rather than re-produce it here                    
+            'name' => \&Class::MOP::Attribute::name
         }
     ))
 );
@@ -248,8 +247,11 @@ Class::MOP::Attribute->meta->add_attribute(
         reader => {
             # NOTE: we need to do this in order 
             # for the instance meta-object to 
-            # not fall into meta-circular death            
-            'associated_class' => sub { (shift)->{associated_class} }
+            # not fall into meta-circular death       
+            # 
+            # we just alias the original method
+            # rather than re-produce it here                 
+            'associated_class' => \&Class::MOP::Attribute::associated_class
         }
     ))
 );
index 5906784..20e5769 100644 (file)
@@ -73,6 +73,9 @@ sub make_metaclass_immutable {
             )            
         );
     }
+    
+    # now cache the method map ...
+    $metaclass->{'___method_map'} = $metaclass->get_method_map;
           
     bless $metaclass => $class;
 }
@@ -135,6 +138,7 @@ sub get_meta_instance                 {   (shift)->{'___get_meta_instance'}
 sub class_precedence_list             { @{(shift)->{'___class_precedence_list'}}             }
 sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} }
 sub get_mutable_metaclass_name        {   (shift)->{'___original_class'}                     }
+sub get_method_map                    {   (shift)->{'___method_map'}                         }
 
 1;
 
@@ -259,6 +263,8 @@ to this method, which
 
 =item B<get_meta_instance>
 
+=item B<get_method_map>
+
 =back
 
 =head1 AUTHORS
index d34604a..16fc8ad 100644 (file)
@@ -11,8 +11,10 @@ use B            'svref_2object';
 our $VERSION   = '0.03';
 our $AUTHORITY = 'cpan:STEVAN';
 
-use overload '&{}' => sub { $_[0]->{body} },
-             fallback => 1;
+# NOTE:
+# if poked in the right way, 
+# they should act like CODE refs.
+use overload '&{}' => sub { $_[0]->{body} }, fallback => 1;
 
 # introspection
 
@@ -33,15 +35,27 @@ sub wrap {
     } => blessed($class) || $class;
 }
 
+## accessors
+
 sub body { (shift)->{body} }
 
 # informational
 
+# NOTE: 
+# this may not be the same name 
+# as the class you got it from
+# This gets the package stash name 
+# associated with the actual CODE-ref
 sub package_name { 
        my $code = (shift)->{body};
        svref_2object($code)->GV->STASH->NAME;
 }
 
+# NOTE: 
+# this may not be the same name 
+# as the method name it is stored
+# with. This gets the name associated
+# with the actual CODE-ref
 sub name { 
        my $code = (shift)->{body};
        svref_2object($code)->GV->NAME;