X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=adbccfa920223763f336fd9b52712a6d8795d6e7;hb=d90b42a6df39896a4a851b6174cce7558173d7d5;hp=3fd61eda374e3377ed2880b7abb8c7d6a94064c6;hpb=148b469742669e1a506538200f624dcdaeeb510a;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 3fd61ed..adbccfa 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util ();
+use Scalar::Util 'weaken';
 
 use Class::MOP::Class;
 use Class::MOP::Attribute;
@@ -13,9 +13,34 @@ use Class::MOP::Method;
 
 use Class::MOP::Class::Immutable;
 
-our $VERSION   = '0.33';
+our $VERSION   = '0.35';
 our $AUTHORITY = 'cpan:STEVAN';
 
+{
+    # 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 get_metaclass_by_name       { $METAS{$_[0]}         }
+    sub store_metaclass_by_name     { $METAS{$_[0]} = $_[1] }  
+    sub weaken_metaclass            { weaken($METAS{$_[0]}) }            
+    sub does_metaclass_exist        { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
+    sub remove_metaclass_by_name    { $METAS{$_[0]} = undef }     
+    
+    # NOTE:
+    # We only cache metaclasses, meaning instances of 
+    # Class::MOP::Class. We do not cache instance of 
+    # Class::MOP::Package or Class::MOP::Module. Mostly
+    # because I don't yet see a good reason to do so.        
+}
+
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...
 ## ----------------------------------------------------------------------------
@@ -49,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',
     ))
@@ -58,16 +86,15 @@ Class::MOP::Package->meta->add_attribute(
 Class::MOP::Package->meta->add_attribute(
     Class::MOP::Attribute->new('%:namespace' => (
         reader => {
-            'namespace' => sub { (shift)->{'%:namespace'} }
-        },
-        default => sub {
-            my ($class) = @_;
-            no strict 'refs';
-            return \%{$class->name . '::'};
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here
+            'namespace' => \&Class::MOP::Package::namespace
         },
         # NOTE:
         # protect this from silliness 
         init_arg => '!............( DO NOT DO THIS )............!',
+        default  => sub { \undef }
     ))
 );
 
@@ -96,14 +123,15 @@ 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 
         init_arg => '!............( DO NOT DO THIS )............!',
+        default  => sub { \undef }
     ))
 );
 
@@ -116,14 +144,15 @@ 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 
         init_arg => '!............( DO NOT DO THIS )............!',
+        default  => sub { \undef }
     ))
 );
 
@@ -135,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 { {} }
@@ -144,8 +176,25 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('%:methods' => (
+        reader   => {          
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here            
+            'get_method_map' => \&Class::MOP::Class::get_method_map
+        },
+        default => sub { {} }
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('$:attribute_metaclass' => (
-        reader   => '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',
     ))
@@ -153,7 +202,12 @@ Class::MOP::Class->meta->add_attribute(
 
 Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('$:method_metaclass' => (
-        reader   => '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',        
     ))
@@ -164,8 +218,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',        
@@ -186,8 +243,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
         }
     ))
 );
@@ -197,61 +257,70 @@ 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
         }
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('accessor' => (
-        reader    => 'accessor',
-        predicate => 'has_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' => (
-        reader    => 'reader',
-        predicate => 'has_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('writer' => (
-        reader    => 'writer',
-        predicate => 'has_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' => (
-        reader    => 'predicate',
-        predicate => 'has_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' => (
-        reader    => 'clearer',
-        predicate => 'has_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('init_arg' => (
-        reader    => 'init_arg',
-        predicate => 'has_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' => (
         # default has a custom 'reader' method ...
-        predicate => 'has_default',
+        predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },        
     ))
 );
 
+Class::MOP::Attribute->meta->add_attribute(
+    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
@@ -283,15 +352,119 @@ Class::MOP::Attribute->meta->add_method('clone' => sub {
 });
 
 ## --------------------------------------------------------
+## Class::MOP::Method
+
+Class::MOP::Method->meta->add_attribute(
+    Class::MOP::Attribute->new('body' => (
+        reader => { 'body' => \&Class::MOP::Method::body },
+    ))
+);
+
+## --------------------------------------------------------
+## Class::MOP::Method::Wrapped
+
+# NOTE:
+# the way this item is initialized, this 
+# really does not follow the standard 
+# 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::Method::Accessor
+
+Class::MOP::Method::Accessor->meta->add_attribute(
+    Class::MOP::Attribute->new('attribute' => (
+        reader => { 
+            'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute 
+        },
+    ))    
+);
+
+Class::MOP::Method::Accessor->meta->add_attribute(
+    Class::MOP::Attribute->new('accessor_type' => (
+        reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
+    ))    
+);
+
+Class::MOP::Method::Accessor->meta->add_attribute(
+    Class::MOP::Attribute->new('is_inline' => (
+        reader => { 'is_inline' => \&Class::MOP::Method::Accessor::is_inline },
+    ))    
+);
+
+## --------------------------------------------------------
+## Class::MOP::Method::Constructor
+
+Class::MOP::Method::Constructor->meta->add_attribute(
+    Class::MOP::Attribute->new('options' => (
+        reader => { 
+            'options' => \&Class::MOP::Method::Constructor::options 
+        },
+    ))    
+);
+
+Class::MOP::Method::Constructor->meta->add_attribute(
+    Class::MOP::Attribute->new('meta_instance' => (
+        reader => { 
+            'meta_instance' => \&Class::MOP::Method::Constructor::meta_instance 
+        },
+    ))    
+);
+
+Class::MOP::Method::Constructor->meta->add_attribute(
+    Class::MOP::Attribute->new('attributes' => (
+        reader => { 
+            'attributes' => \&Class::MOP::Method::Constructor::attributes 
+        },
+    ))    
+);
+
+## --------------------------------------------------------
+## Class::MOP::Instance
+
+# NOTE:
+# these don't yet do much of anything, but are just 
+# included for completeness
+
+Class::MOP::Instance->meta->add_attribute(
+    Class::MOP::Attribute->new('meta')
+);
+
+Class::MOP::Instance->meta->add_attribute(
+    Class::MOP::Attribute->new('slots')
+);
+
+## --------------------------------------------------------
 ## Now close all the Class::MOP::* classes
 
-Class::MOP::Package  ->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Module   ->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Class    ->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Attribute->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Method   ->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Instance ->meta->make_immutable(inline_constructor => 0);
-Class::MOP::Object   ->meta->make_immutable(inline_constructor => 0);
+# 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.
+
+$_->meta->make_immutable(
+    inline_constructor => 0,
+    inline_accessors   => 0,
+) for qw/
+    Class::MOP::Package  
+    Class::MOP::Module   
+    Class::MOP::Class    
+    
+    Class::MOP::Attribute
+    Class::MOP::Method   
+    Class::MOP::Instance 
+    
+    Class::MOP::Object   
+
+    Class::MOP::Method::Accessor
+    Class::MOP::Method::Constructor    
+    Class::MOP::Method::Wrapped           
+/;
 
 1;
 
@@ -471,6 +644,42 @@ See L<Class::MOP::Method> for more details.
 
 =back
 
+=head1 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.
+
+=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. 
+
+=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>.
+
+=item B<get_metaclass_by_name ($name)>
+
+=item B<store_metaclass_by_name ($name, $meta)>
+
+=item B<weaken_metaclass ($name)>
+
+=item B<does_metaclass_exist ($name)>
+
+=item B<remove_metaclass_by_name ($name)>
+
+=back
+
 =head1 SEE ALSO
 
 =head2 Books
@@ -531,6 +740,16 @@ L<http://citeseer.ist.psu.edu/37617.html>
 
 =back
 
+=head2 Article 
+
+=over 4
+
+=item CPAN Module Review of Class::MOP 
+
+L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
+
+=back
+
 =head1 SIMILAR MODULES
 
 As I have said above, this module is a class-builder-builder, so it is 
@@ -554,21 +773,25 @@ L<Devel::Cover> report on this module's test suite.
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
  File                           stmt   bran   cond    sub    pod   time  total
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/MOP.pm                  100.0  100.0  100.0  100.0    n/a   19.8  100.0
- Class/MOP/Attribute.pm        100.0  100.0   91.7   61.2  100.0   14.3   87.9
- Class/MOP/Class.pm             97.6   91.3   77.3   98.4  100.0   56.4   93.2
- Class/MOP/Instance.pm          91.1   75.0   33.3   91.7  100.0    6.8   90.7
- Class/MOP/Method.pm            97.6   60.0   52.9   76.9  100.0    1.6   82.6
- metaclass.pm                  100.0  100.0   83.3  100.0    n/a    1.0   97.7
+ Class/MOP.pm                   97.7  100.0   88.9   94.7  100.0    3.2   96.6
+ Class/MOP/Attribute.pm         75.5   77.9   82.4   88.3  100.0    4.0   81.5
+ Class/MOP/Class.pm             96.9   88.8   72.1   98.2  100.0   35.8   91.4
+ Class/MOP/Class/Immutable.pm   88.2   60.0    n/a   95.5  100.0    0.5   84.6
+ Class/MOP/Instance.pm          86.4   75.0   33.3   86.2  100.0    1.2   87.5
+ Class/MOP/Method.pm            97.5   75.0   61.5   80.6  100.0   12.7   89.7
+ Class/MOP/Module.pm           100.0    n/a   55.6  100.0  100.0    0.1   90.7
+ Class/MOP/Object.pm            73.3    n/a   20.0   80.0  100.0    0.1   66.7
+ Class/MOP/Package.pm           94.6   71.7   33.3  100.0  100.0   42.2   87.0
+ metaclass.pm                  100.0  100.0   83.3  100.0    n/a    0.2   97.7
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total                          97.5   88.5   75.5   82.8  100.0  100.0   91.2
+ Total                          91.3   80.4   69.8   91.9  100.0  100.0   88.1
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 ACKNOWLEDGEMENTS
 
 =over 4
 
-=item Rob Kinyon E<lt>rob@iinteractive.comE<gt>
+=item Rob Kinyon
 
 Thanks to Rob for actually getting the development of this module kick-started.