From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 29 Aug 2006 15:22:49 +0000 (+0000)
Subject: adding in the additional metaclasses
X-Git-Tag: 0_35~13^2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b616440737a53f030c5b11b8e5bd5af17e76b641;p=gitmo%2FClass-MOP.git

adding in the additional metaclasses
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7e450d7..dbc4136 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -336,6 +336,27 @@ 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::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')
+);
+
+## --------------------------------------------------------
 ## Now close all the Class::MOP::* classes
 
 Class::MOP::Package  ->meta->make_immutable(inline_constructor => 0);
@@ -346,6 +367,10 @@ 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);
 
+# Class::MOP::Method subclasses 
+Class::MOP::Attribute::Accessor->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Method::Wrapped    ->meta->make_immutable(inline_constructor => 0);
+
 1;
 
 __END__
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index d30d026..a0f0a0b 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -349,7 +349,8 @@ use warnings;
 
 use Class::MOP::Method;
 
-our $VERSION = '0.01';
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Method';
 
diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm
index 20e5769..e40198f 100644
--- a/lib/Class/MOP/Class/Immutable.pm
+++ b/lib/Class/MOP/Class/Immutable.pm
@@ -24,6 +24,19 @@ sub remove_attribute      { confess 'Cannot call method "remove_attribute" on an
 sub add_package_symbol    { confess 'Cannot call method "add_package_symbol" on an immutable instance'    }
 sub remove_package_symbol { confess 'Cannot call method "remove_package_symbol" on an immutable instance' }
 
+sub get_package_symbol {
+    my ($self, $variable) = @_;    
+    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
+    return *{$self->namespace->{$name}}{$type}
+        if exists $self->namespace->{$name};
+    # NOTE: 
+    # we have to do this here in order to preserve 
+    # perl's autovivification of variables. However 
+    # we do cut off direct access to add_package_symbol
+    # as shown above.
+    $self->Class::MOP::Package::add_package_symbol($variable);
+}
+
 # NOTE:
 # superclasses is an accessor, so 
 # it just cannot be changed
@@ -249,8 +262,21 @@ to this method, which
 
 =item B<remove_package_symbol>
 
+=back
+
+=head2 Methods which work slightly differently.
+
+=over 4
+
 =item B<superclasses>
 
+This method becomes read-only in an immutable class.
+
+=item B<get_package_symbol>
+
+This method must handle package variable autovivification 
+correctly, while still disallowing C<add_package_symbol>.
+
 =back
 
 =head2 Cached methods
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 16fc8ad..dbb7773 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -75,7 +75,8 @@ use Carp         'confess';
 use Scalar::Util 'reftype', 'blessed';
 use Sub::Name    'subname';
 
-our $VERSION = '0.01';
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Method';	
 
diff --git a/t/000_load.t b/t/000_load.t
index 35c93e8..e3cdb44 100644
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 19;
 
 BEGIN {
     use_ok('Class::MOP');
@@ -17,13 +17,15 @@ BEGIN {
 # make sure we are tracking metaclasses correctly
 
 my %METAS = (
-    'Class::MOP::Attribute' => Class::MOP::Attribute->meta, 
-    'Class::MOP::Package'   => Class::MOP::Package->meta, 
-    'Class::MOP::Module'    => Class::MOP::Module->meta,     
-    'Class::MOP::Class'     => Class::MOP::Class->meta, 
-    'Class::MOP::Method'    => Class::MOP::Method->meta,  
-    'Class::MOP::Instance'  => Class::MOP::Instance->meta,   
-    'Class::MOP::Object'    => Class::MOP::Object->meta,          
+    'Class::MOP::Attribute'           => Class::MOP::Attribute->meta, 
+    'Class::MOP::Attribute::Accessor' => Class::MOP::Attribute::Accessor->meta,     
+    'Class::MOP::Package'             => Class::MOP::Package->meta, 
+    'Class::MOP::Module'              => Class::MOP::Module->meta,     
+    'Class::MOP::Class'               => Class::MOP::Class->meta, 
+    'Class::MOP::Method'              => Class::MOP::Method->meta,  
+    'Class::MOP::Method::Wrapped'     => Class::MOP::Method::Wrapped->meta,      
+    'Class::MOP::Instance'            => Class::MOP::Instance->meta,   
+    'Class::MOP::Object'              => Class::MOP::Object->meta,          
 );
 
 ok($_->is_immutable(), '... ' . $_->name . ' is immutable') for values %METAS;
@@ -36,10 +38,12 @@ is_deeply(
 is_deeply(
     [ sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances ],
     [ 
-        Class::MOP::Attribute->meta, 
+        Class::MOP::Attribute->meta,
+        Class::MOP::Attribute::Accessor->meta, 
         Class::MOP::Class->meta, 
         Class::MOP::Instance->meta,         
         Class::MOP::Method->meta,
+        Class::MOP::Method::Wrapped->meta,
         Class::MOP::Module->meta, 
         Class::MOP::Object->meta,          
         Class::MOP::Package->meta,              
@@ -49,10 +53,12 @@ is_deeply(
 is_deeply(
     [ sort { $a cmp $b } Class::MOP::get_all_metaclass_names() ],
     [ qw/
-        Class::MOP::Attribute       
+        Class::MOP::Attribute   
+        Class::MOP::Attribute::Accessor    
         Class::MOP::Class
         Class::MOP::Instance
         Class::MOP::Method
+        Class::MOP::Method::Wrapped
         Class::MOP::Module  
         Class::MOP::Object        
         Class::MOP::Package                      
@@ -62,13 +68,15 @@ is_deeply(
 is_deeply(
     [ map { $_->meta->identifier } sort { $a cmp $b } Class::MOP::get_all_metaclass_names() ],
     [ 
-       "Class::MOP::Attribute-" . $Class::MOP::Attribute::VERSION . "-cpan:STEVAN",   
-       "Class::MOP::Class-"     . $Class::MOP::Class::VERSION     . "-cpan:STEVAN",
-       "Class::MOP::Instance-"  . $Class::MOP::Instance::VERSION  . "-cpan:STEVAN",
-       "Class::MOP::Method-"    . $Class::MOP::Method::VERSION    . "-cpan:STEVAN",
-       "Class::MOP::Module-"    . $Class::MOP::Module::VERSION    . "-cpan:STEVAN",
-       "Class::MOP::Object-"    . $Class::MOP::Object::VERSION    . "-cpan:STEVAN",
-       "Class::MOP::Package-"   . $Class::MOP::Package::VERSION   . "-cpan:STEVAN",
+       "Class::MOP::Attribute-"           . $Class::MOP::Attribute::VERSION           . "-cpan:STEVAN",  
+       "Class::MOP::Attribute::Accessor-" . $Class::MOP::Attribute::Accessor::VERSION . "-cpan:STEVAN",          
+       "Class::MOP::Class-"               . $Class::MOP::Class::VERSION               . "-cpan:STEVAN",
+       "Class::MOP::Instance-"            . $Class::MOP::Instance::VERSION            . "-cpan:STEVAN",
+       "Class::MOP::Method-"              . $Class::MOP::Method::VERSION              . "-cpan:STEVAN",
+       "Class::MOP::Method::Wrapped-"     . $Class::MOP::Method::Wrapped::VERSION     . "-cpan:STEVAN",       
+       "Class::MOP::Module-"              . $Class::MOP::Module::VERSION              . "-cpan:STEVAN",
+       "Class::MOP::Object-"              . $Class::MOP::Object::VERSION              . "-cpan:STEVAN",
+       "Class::MOP::Package-"             . $Class::MOP::Package::VERSION             . "-cpan:STEVAN",
     ],
     '... got all the metaclass identifiers');