make add_symbol go through ->namespace too

[gitmo/Package-Stash.git] / lib / Package / Stash / PP.pm

diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 227970a..f60ac4a 100644 (file)
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -40,6 +40,9 @@ sub new {
               . "currently support anonymous stashes. You should install "
               . "Package::Stash::XS";
     }
+    elsif ($package !~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/) {
+        confess "$package is not a module name";
+    }
 
     return bless {
         'package' => $package,
@@ -86,17 +89,31 @@ sub namespace {
     sub _deconstruct_variable_name {
         my ($self, $variable) = @_;
 
-        (defined $variable && length $variable)
-            || confess "You must pass a variable name";
-
-        my $sigil = substr($variable, 0, 1, '');
-
-        if (exists $SIGIL_MAP{$sigil}) {
-            return ($variable, $sigil, $SIGIL_MAP{$sigil});
+        my @ret;
+        if (ref($variable) eq 'HASH') {
+            @ret = @{$variable}{qw[name sigil type]};
         }
         else {
-            return ("${sigil}${variable}", '', $SIGIL_MAP{''});
+            (defined $variable && length $variable)
+                || confess "You must pass a variable name";
+
+            my $sigil = substr($variable, 0, 1, '');
+
+            if (exists $SIGIL_MAP{$sigil}) {
+                @ret = ($variable, $sigil, $SIGIL_MAP{$sigil});
+            }
+            else {
+                @ret = ("${sigil}${variable}", '', $SIGIL_MAP{''});
+            }
         }
+
+        # XXX in pure perl, this will access things in inner packages,
+        # in xs, this will segfault - probably look more into this at
+        # some point
+        ($ret[0] !~ /::/)
+            || confess "Variable names may not contain ::";
+
+        return @ret;
     }
 }
 
@@ -116,11 +133,7 @@ sub _valid_for_type {
 sub add_symbol {
     my ($self, $variable, $initial_value, %opts) = @_;
 
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
-        ? @{$variable}{qw[name sigil type]}
-        : $self->_deconstruct_variable_name($variable);
-
-    my $pkg = $self->name;
+    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
 
     if (@_ > 2) {
         $self->_valid_for_type($initial_value, $type)
@@ -137,13 +150,14 @@ sub add_symbol {
             my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0);
 
             # http://perldoc.perl.org/perldebguts.html#Debugger-Internals
-            $DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num";
+            $DB::sub{$self->name . '::' . $name} = "$filename:$first_line_num-$last_line_num";
         }
     }
 
-    no strict 'refs';
-    no warnings 'redefine', 'misc', 'prototype';
-    *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
+    my $namespace = $self->namespace;
+    my $gv = $namespace->{$name} || Symbol::gensym;
+    *$gv = ref $initial_value ? $initial_value : \$initial_value;
+    $namespace->{$name} = *$gv;
 }
 
 sub remove_glob {
@@ -154,9 +168,7 @@ sub remove_glob {
 sub has_symbol {
     my ($self, $variable) = @_;
 
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
-        ? @{$variable}{qw[name sigil type]}
-        : $self->_deconstruct_variable_name($variable);
+    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
 
     my $namespace = $self->namespace;
 
@@ -186,9 +198,7 @@ sub has_symbol {
 sub get_symbol {
     my ($self, $variable, %opts) = @_;
 
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
-        ? @{$variable}{qw[name sigil type]}
-        : $self->_deconstruct_variable_name($variable);
+    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
 
     my $namespace = $self->namespace;
 
@@ -250,9 +260,7 @@ sub get_or_add_symbol {
 sub remove_symbol {
     my ($self, $variable) = @_;
 
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
-        ? @{$variable}{qw[name sigil type]}
-        : $self->_deconstruct_variable_name($variable);
+    my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
 
     # FIXME:
     # no doubt this is grossly inefficient and