From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 10 Jun 2008 03:54:39 +0000 (+0000)
Subject: *_package_symbol all now take HASH ref as well as string
X-Git-Tag: 0_64~33
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8b49a47227fa5b84e4a5f02f40d9e38ed3c2a0ca;p=gitmo%2FClass-MOP.git

*_package_symbol all now take HASH ref as well as string
---

diff --git a/Changes b/Changes
index 273b51b..bab6c06 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,13 @@ Revision history for Perl extension Class-MOP.
     * Class::MOP::Class
       - now stores the instance of the instance 
         metaclass to avoid needless recomputation
+        and deletes it when the cache is blown
+
+    * Class::MOP::Package
+      - {add, has, get, remove}_package_symbol all 
+        now accept a HASH ref argument as well as the
+        string. All internal usages now use the HASH
+        ref version.
 
     * Class::MOP
       - MOP.xs does sanity checks on the coderef 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index a3ac27d..86d6f27 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -475,10 +475,11 @@ sub rebless_instance {
 # Inheritance
 
 sub superclasses {
-    my $self = shift;
+    my $self     = shift;
+    my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' };
     if (@_) {
         my @supers = @_;
-        @{$self->get_package_symbol('@ISA')} = @supers;
+        @{$self->get_package_symbol($var_spec)} = @supers;
         # NOTE:
         # we need to check the metaclass
         # compatibility here so that we can
@@ -487,7 +488,7 @@ sub superclasses {
         # we don't know about
         $self->check_metaclass_compatability();
     }
-    @{$self->get_package_symbol('@ISA')};
+    @{$self->get_package_symbol($var_spec)};
 }
 
 sub subclasses {
@@ -608,7 +609,8 @@ sub add_method {
     $self->get_method_map->{$method_name} = $method;
     
     my $full_method_name = ($self->name . '::' . $method_name);    
-    $self->add_package_symbol("&${method_name}" => 
+    $self->add_package_symbol(
+        { sigil => '&', type => 'CODE', name => $method_name }, 
         Class::MOP::subname($full_method_name => $body)
     );
     $self->update_package_cache_flag;    
@@ -693,7 +695,9 @@ sub alias_method {
     ('CODE' eq ref($body))
         || confess "Your code block must be a CODE reference";
 
-    $self->add_package_symbol("&${method_name}" => $body);
+    $self->add_package_symbol(
+        { sigil => '&', type => 'CODE', name => $method_name } => $body
+    );
     $self->update_package_cache_flag;     
 }
 
@@ -727,7 +731,9 @@ sub remove_method {
 
     my $removed_method = delete $self->get_method_map->{$method_name};
     
-    $self->remove_package_symbol("&${method_name}");
+    $self->remove_package_symbol(
+        { sigil => '&', type => 'CODE', name => $method_name }
+    );
     
     $self->update_package_cache_flag;        
 
diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm
index bb5859f..2bf2668 100644
--- a/lib/Class/MOP/Module.pm
+++ b/lib/Class/MOP/Module.pm
@@ -13,12 +13,12 @@ use base 'Class::MOP::Package';
 
 sub version {  
     my $self = shift;
-    ${$self->get_package_symbol('$VERSION')};
+    ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'VERSION' })};
 }
 
 sub authority {  
     my $self = shift;
-    ${$self->get_package_symbol('$AUTHORITY')};
+    ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'AUTHORITY' })};
 }
 
 sub identifier {
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index dbac031..05c5fdd 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -87,7 +87,9 @@ sub namespace {
 sub add_package_symbol {
     my ($self, $variable, $initial_value) = @_;
 
-    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
+    my ($name, $sigil, $type) = ref $variable eq 'HASH'
+        ? @{$variable}{qw[name sigil type]}
+        : $self->_deconstruct_variable_name($variable); 
 
     my $pkg = $self->{'$!package'};
 
@@ -107,7 +109,9 @@ sub remove_package_glob {
 sub has_package_symbol {
     my ($self, $variable) = @_;
 
-    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
+    my ($name, $sigil, $type) = ref $variable eq 'HASH'
+        ? @{$variable}{qw[name sigil type]}
+        : $self->_deconstruct_variable_name($variable);
     
     my $namespace = $self->namespace;
     
@@ -137,7 +141,9 @@ sub has_package_symbol {
 sub get_package_symbol {
     my ($self, $variable) = @_;    
 
-    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
+    my ($name, $sigil, $type) = ref $variable eq 'HASH'
+        ? @{$variable}{qw[name sigil type]}
+        : $self->_deconstruct_variable_name($variable);
 
     my $namespace = $self->namespace;
 
@@ -161,32 +167,41 @@ sub get_package_symbol {
 sub remove_package_symbol {
     my ($self, $variable) = @_;
 
-    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
+    my ($name, $sigil, $type) = ref $variable eq 'HASH'
+        ? @{$variable}{qw[name sigil type]}
+        : $self->_deconstruct_variable_name($variable);
 
     # FIXME:
     # no doubt this is grossly inefficient and 
     # could be done much easier and faster in XS
 
+    my ($scalar_desc, $array_desc, $hash_desc, $code_desc) = (
+        { sigil => '$', type => 'SCALAR', name => $name },
+        { sigil => '@', type => 'ARRAY',  name => $name },
+        { sigil => '%', type => 'HASH',   name => $name },
+        { sigil => '&', type => 'CODE',   name => $name },
+    );
+
     my ($scalar, $array, $hash, $code);
     if ($type eq 'SCALAR') {
-        $array  = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);
-        $hash   = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);     
-        $code   = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);     
+        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);
+        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);     
+        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);     
     }
     elsif ($type eq 'ARRAY') {
-        $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
-        $hash   = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);     
-        $code   = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);
+        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
+        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);     
+        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);
     }
     elsif ($type eq 'HASH') {
-        $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
-        $array  = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);        
-        $code   = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);      
+        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
+        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);        
+        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);      
     }
     elsif ($type eq 'CODE') {
-        $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
-        $array  = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);        
-        $hash   = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);        
+        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
+        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);        
+        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);        
     }    
     else {
         confess "This should never ever ever happen";
@@ -194,10 +209,10 @@ sub remove_package_symbol {
         
     $self->remove_package_glob($name);
     
-    $self->add_package_symbol(('$' . $name) => $scalar) if defined $scalar;      
-    $self->add_package_symbol(('@' . $name) => $array)  if defined $array;    
-    $self->add_package_symbol(('%' . $name) => $hash)   if defined $hash;
-    $self->add_package_symbol(('&' . $name) => $code)   if defined $code;            
+    $self->add_package_symbol($scalar_desc => $scalar) if defined $scalar;      
+    $self->add_package_symbol($array_desc  => $array)  if defined $array;    
+    $self->add_package_symbol($hash_desc   => $hash)   if defined $hash;
+    $self->add_package_symbol($code_desc   => $code)   if defined $code;            
 }
 
 sub list_all_package_symbols {