encapsulated-package-features

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index af04c94..05176ef 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -53,6 +53,15 @@ Class::MOP::Package->meta->add_attribute(
     ))
 );
 
+# NOTE:
+# use the metaclass to construct the meta-package
+# which is a superclass of the metaclass itself :P
+Class::MOP::Package->meta->add_method('initialize' => sub {
+    my $class        = shift;
+    my $package_name = shift;
+    $class->meta->new_object(':package' => $package_name, @_);  
+});
+
 ## Class::MOP::Class
 
 Class::MOP::Class->meta->add_attribute(
@@ -97,6 +106,12 @@ Class::MOP::Class->meta->add_attribute(
     ))
 );
 
+# NOTE:
+# we don't actually need to tie the knot with 
+# Class::MOP::Class here, it is actually handled 
+# within Class::MOP::Class itself in the 
+# construct_class_instance method. 
+
 ## Class::MOP::Attribute
 
 Class::MOP::Attribute->meta->add_attribute(

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index f881534..b2cb51d 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 
 use base 'Class::MOP::Module';
 
@@ -93,7 +93,7 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
         $class = blessed($class) || $class;
         # now create the metaclass
         my $meta;
-        if ($class =~ /^Class::MOP::/) {    
+        if ($class =~ /^Class::MOP::Class$/) {    
             $meta = bless { 
                 '$:package'             => $package_name, 
                 '%:attributes'          => {},
@@ -299,10 +299,9 @@ sub clone_instance {
 
 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 
@@ -311,7 +310,7 @@ sub superclasses {
         # we don't know about
         $self->check_metaclass_compatability();
     }
-    @{$self->name . '::ISA'};
+    @{$self->get_package_symbol('@ISA')};
 }
 
 sub class_precedence_list {
@@ -342,11 +341,11 @@ sub add_method {
         || confess "Your code block must be a CODE reference";
     my $full_method_name = ($self->name . '::' . $method_name);    
 
+    # 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} = subname $full_method_name => $method;
+    $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
 }
 
 {
@@ -420,41 +419,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);
 
+    # 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 );
+    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__';      
 
-    #if ( $self->name->can("meta") ) {
-        # don't bless (destructive operation) classes that didn't ask for it
-
-        # at this point we are relatively sure 
-        # it is our method, so we bless/wrap it 
-        $self->method_metaclass->wrap($method) unless blessed($method);
-    #}
+    # FIXME:
+    # dont bless subs, its bad mkay
+    $self->method_metaclass->wrap($method) unless blessed($method);
+    
     return 1;
 }
 
@@ -464,9 +455,8 @@ sub get_method {
         || confess "You must define a method name";
 
     return unless $self->has_method($method_name);
-
-    no strict 'refs';    
-    return \&{$self->name . '::' . $method_name};
+ 
+    return $self->get_package_symbol("&${method_name}");
 }
 
 sub remove_method {
@@ -476,8 +466,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;
@@ -485,8 +474,7 @@ sub remove_method {
 
 sub get_method_list {
     my $self = shift;
-    no strict 'refs';
-    grep { $self->has_method($_) } keys %{$self->name . '::'};
+    grep { $self->has_method($_) } $self->list_all_package_symbols;
 }
 
 sub compute_all_applicable_methods {
@@ -574,9 +562,6 @@ sub add_attribute {
     $attribute->attach_to_class($self);
     $attribute->install_accessors();
     $self->get_attribute_map->{$attribute->name} = $attribute;
-
-       # FIXME
-       # in theory we have to tell everyone the slot structure may have changed
 }
 
 sub has_attribute {

diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm
index eee05f5..7e18bdc 100644 (file)
--- a/lib/Class/MOP/Module.pm
+++ b/lib/Class/MOP/Module.pm
@@ -6,7 +6,12 @@ use warnings;
 
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.01';
+our $VERSION   = '0.02';
+#our $AUTHORITY = {
+#    cpan   => 'STEVAN',
+#    mailto => 'stevan@iinteractive.com',
+#    http   => '//www.iinteractive.com/'
+#};
 
 use base 'Class::MOP::Package';
 
@@ -17,11 +22,24 @@ sub meta {
     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
+# QUESTION:
+# can the version be an attribute of the 
+# module? I think it should be, but we need
+# to somehow assure that it always is stored
+# in the symbol table instead of being stored 
+# into the instance structure itself
+
 sub version {  
     my $self = shift;
     ${$self->get_package_symbol('$VERSION')};
 }
 
+#sub authority {  
+#    my $self = shift;
+#    $self->get_package_symbol('$AUTHORITY');
+#}
+
+
 1;
 
 __END__

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 0f9849d..82a7324 100644 (file)
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -7,7 +7,7 @@ use warnings;
 use Scalar::Util 'blessed';
 use Carp         'confess';
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 # introspection
 
@@ -19,8 +19,11 @@ sub meta {
 # creation ...
 
 sub initialize {
-    my ($class, $package) = @_;
-    bless { '$:package' => $package } => $class;
+    my $class        = shift;
+    my $package_name = shift;
+    # we hand-construct the class 
+    # until we can bootstrap it
+    return bless { '$:package' => $package_name } => $class;
 }
 
 # Attributes
@@ -56,7 +59,7 @@ sub name { $_[0]->{'$:package'} }
             || confess "I do not recognize that sigil '$sigil'";
     
         no strict 'refs';
-        no warnings 'misc';
+        no warnings 'misc', 'redefine';
         *{$self->name . '::' . $name} = $initial_value;    
     }
 
@@ -121,13 +124,29 @@ sub name { $_[0]->{'$:package'} }
             undef %{$self->name . '::' . $name};    
         }
         elsif ($SIGIL_MAP{$sigil} eq 'CODE') {
-            undef &{$self->name . '::' . $name};    
+            # FIXME:
+            # this is crap, it is probably much 
+            # easier to write this in XS.
+            my ($scalar, @array, %hash);
+            $scalar = ${$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{SCALAR};
+            @array  = @{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{ARRAY};
+            %hash   = %{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{HASH};
+            delete ${$self->name . '::'}{$name};
+            ${$self->name . '::' . $name} = $scalar if defined $scalar;
+            @{$self->name . '::' . $name} = @array  if scalar  @array;
+            %{$self->name . '::' . $name} = %hash   if keys    %hash;            
         }    
         else {
             confess "This should never ever ever happen";
         }
     }
+    
+}
 
+sub list_all_package_symbols {
+    my ($self) = @_;
+    no strict 'refs';
+    return keys %{$self->name . '::'};
 }
 
 1;
@@ -162,6 +181,8 @@ Class::MOP::Package - Package Meta Object
 
 =item B<remove_package_symbol>
 
+=item B<list_all_package_symbols>
+
 =back
 
 =head1 AUTHORS

diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 018b7c2..5972bdb 100644 (file)
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 171;
+use Test::More tests => 173;
 use Test::Exception;
 
 BEGIN {
@@ -34,7 +34,7 @@ my @class_mop_package_methods = qw(
 
     name
     
-    add_package_symbol get_package_symbol has_package_symbol remove_package_symbol    
+    add_package_symbol get_package_symbol has_package_symbol remove_package_symbol list_all_package_symbols    
 );
 
 my @class_mop_module_methods = qw(