X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSymbol.pm;h=1e408b59f7162d775ef4ad19e7dc081f5964b7b6;hb=d87d3eede5d67a7d281a1d929949e466e06bc21a;hp=a95383a5d68cf4783080a173ac47d0278c8d6b86;hpb=c2e66d9e68806a7000ee1a4760c35703a0e0ae89;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Symbol.pm b/lib/Symbol.pm
index a95383a..1e408b5 100644
--- a/lib/Symbol.pm
+++ b/lib/Symbol.pm
@@ -15,8 +15,11 @@ Symbol - manipulate Perl symbols and their names
 
     ungensym $sym;      # no effect
 
-    print qualify("x"), "\n";              # "Test::x"
-    print qualify("x", "FOO"), "\n"        # "FOO::x"
+    # replace *FOO{IO} handle but not $FOO, %FOO, etc.
+    *FOO = geniosym;
+
+    print qualify("x"), "\n";              # "main::x"
+    print qualify("x", "FOO"), "\n";       # "FOO::x"
     print qualify("BAR::x"), "\n";         # "BAR::x"
     print qualify("BAR::x", "FOO"), "\n";  # "BAR::x"
     print qualify("STDOUT", "FOO"), "\n";  # "main::STDOUT" (global)
@@ -31,7 +34,6 @@ Symbol - manipulate Perl symbols and their names
     delete_package('Foo::Bar');
     print "deleted\n" unless exists $Foo::{'Bar::'};
 
-
 =head1 DESCRIPTION
 
 C<Symbol::gensym> creates an anonymous glob and returns a reference
@@ -42,6 +44,10 @@ For backward compatibility with older implementations that didn't
 support anonymous globs, C<Symbol::ungensym> is also provided.
 But it doesn't do anything.
 
+C<Symbol::geniosym> creates an anonymous IO handle.  This can be
+assigned into an existing glob without affecting the non-IO portions
+of the glob.
+
 C<Symbol::qualify> turns unqualified symbol names into qualified
 variable names (e.g. "myvar" -E<gt> "MyPackage::myvar").  If it is given a
 second parameter, C<qualify> uses it as the default package;
@@ -61,16 +67,25 @@ C<Symbol::delete_package> wipes out a whole package namespace.  Note
 this routine is not exported by default--you may want to import it
 explicitly.
 
+=head1 BUGS
+
+C<Symbol::delete_package> is a bit too powerful. It undefines every symbol that
+lives in the specified package. Since perl, for performance reasons, does not
+perform a symbol table lookup each time a function is called or a global
+variable is accessed, some code that has already been loaded and that makes use
+of symbols in package C<Foo> may stop working after you delete C<Foo>, even if
+you reload the C<Foo> module afterwards.
+
 =cut
 
-BEGIN { require 5.002; }
+BEGIN { require 5.005; }
 
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
-@EXPORT_OK = qw(delete_package);
+@EXPORT_OK = qw(delete_package geniosym);
 
-$VERSION = 1.02;
+$VERSION = '1.07';
 
 my $genpkg = "Symbol::";
 my $genseq = 0;
@@ -89,14 +104,23 @@ sub gensym () {
     $ref;
 }
 
+sub geniosym () {
+    my $sym = gensym();
+    # force the IO slot to be filled
+    select(select $sym);
+    *$sym{IO};
+}
+
 sub ungensym ($) {}
 
 sub qualify ($;$) {
     my ($name) = @_;
     if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
 	my $pkg;
-	# Global names: special character, "^x", or other. 
-	if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
+	# Global names: special character, "^xyz", or other. 
+	if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) {
+	    # RGS 2001-11-05 : translate leading ^X to control-char
+	    $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei;
 	    $pkg = "main";
 	}
 	else {