From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 12 May 2010 03:02:16 +0000 (-0500)
Subject: more support for IO slots
X-Git-Tag: 0.01~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=56a29840c0b7b0c4a09243ea05400c3df8ad0823;p=gitmo%2FPackage-Stash.git

more support for IO slots
---

diff --git a/lib/Stash/Manip.pm b/lib/Stash/Manip.pm
index 38177c7..944eab3 100644
--- a/lib/Stash/Manip.pm
+++ b/lib/Stash/Manip.pm
@@ -24,6 +24,9 @@ Manipulating stashes (Perl's symbol tables) is occasionally necessary, but
 incredibly messy, and easy to get wrong. This module hides all of that behind a
 simple API.
 
+NOTE: Most methods in this class require a variable specification that includes
+a sigil. If this sigil is absent, it is assumed to represent the IO slot.
+
 =head1 METHODS
 
 =cut
@@ -75,23 +78,23 @@ sub namespace {
         '@' => 'ARRAY',
         '%' => 'HASH',
         '&' => 'CODE',
+        ''  => 'IO',
     );
 
     sub _deconstruct_variable_name {
         my ($self, $variable) = @_;
 
-        (defined $variable)
+        (defined $variable && length $variable)
             || confess "You must pass a variable name";
 
         my $sigil = substr($variable, 0, 1, '');
 
-        (defined $sigil)
-            || confess "The variable name must include a sigil";
-
-        (exists $SIGIL_MAP{$sigil})
-            || confess "I do not recognize that sigil '$sigil'";
-
-        return ($variable, $sigil, $SIGIL_MAP{$sigil});
+        if (exists $SIGIL_MAP{$sigil}) {
+            return ($variable, $sigil, $SIGIL_MAP{$sigil});
+        }
+        else {
+            return ("${sigil}${variable}", '', $SIGIL_MAP{''});
+        }
     }
 }
 
diff --git a/t/001-basic.t b/t/001-basic.t
index a3ab29d..52ddfaa 100644
--- a/t/001-basic.t
+++ b/t/001-basic.t
@@ -225,22 +225,4 @@ is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for
     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
 }
 
-# check some errors
-
-dies_ok {
-    $foo_stash->add_package_symbol('bar');
-} '... no sigil for bar';
-
-dies_ok {
-    $foo_stash->remove_package_symbol('bar');
-} '... no sigil for bar';
-
-dies_ok {
-    $foo_stash->get_package_symbol('bar');
-} '... no sigil for bar';
-
-dies_ok {
-    $foo_stash->has_package_symbol('bar');
-} '... no sigil for bar';
-
 done_testing;
diff --git a/t/003-io.t b/t/003-io.t
new file mode 100644
index 0000000..a41b2ae
--- /dev/null
+++ b/t/003-io.t
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+    package Foo;
+    open *foo, "<", $0;
+
+    sub foo { }
+}
+
+{
+    package Bar;
+    open *bar, "<", $0;
+
+    sub bar { }
+}
+
+use Stash::Manip;
+
+{
+    my $stash = Stash::Manip->new('Foo');
+    ok($stash->has_package_symbol('&foo'), "has &foo");
+    ok($stash->has_package_symbol('foo'), "has foo");
+    $stash->remove_package_symbol('&foo');
+    ok(!$stash->has_package_symbol('&foo'), "has &foo");
+    ok($stash->has_package_symbol('foo'), "has foo");
+}
+
+{
+    my $stash = Stash::Manip->new('Bar');
+    ok($stash->has_package_symbol('&bar'), "has &bar");
+    ok($stash->has_package_symbol('bar'), "has bar");
+    $stash->remove_package_symbol('bar');
+    ok($stash->has_package_symbol('&bar'), "has &bar");
+    ok(!$stash->has_package_symbol('bar'), "has bar");
+}
+
+{
+    my $stash = Stash::Manip->new('Baz');
+    lives_ok {
+        $stash->add_package_symbol('baz', *Foo::foo{IO});
+    } "can add an IO symbol";
+    ok($stash->has_package_symbol('baz'), "has baz");
+    is($stash->get_package_symbol('baz'), *Foo::foo{IO}, "got the right baz");
+}
+
+done_testing;