diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Symbol.pm | 19 | ||||
-rwxr-xr-x | lib/Symbol.t | 23 |
2 files changed, 40 insertions, 2 deletions
diff --git a/lib/Symbol.pm b/lib/Symbol.pm index 8739bd2b31..d5318085d8 100644 --- a/lib/Symbol.pm +++ b/lib/Symbol.pm @@ -15,6 +15,12 @@ Symbol - manipulate Perl symbols and their names ungensym $sym; # no effect + # localize *FOO IO handle but not $FOO, %FOO, etc. + my $save_fooio = *FOO{IO} || geniosym; + *FOO = geniosym; + use_foo(); + *FOO{IO} = $save_fooio; + print qualify("x"), "\n"; # "Test::x" print qualify("x", "FOO"), "\n" # "FOO::x" print qualify("BAR::x"), "\n"; # "BAR::x" @@ -42,6 +48,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; @@ -68,7 +78,7 @@ 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.04; @@ -89,6 +99,13 @@ sub gensym () { $ref; } +sub geniosym () { + my $sym = gensym(); + # force the IO slot to be filled + select(select $sym); + *$sym{IO}; +} + sub ungensym ($) {} sub qualify ($;$) { diff --git a/lib/Symbol.t b/lib/Symbol.t index 3bac9033fd..5763e5420e 100755 --- a/lib/Symbol.t +++ b/lib/Symbol.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -use Test::More tests => 10; +use Test::More tests => 14; BEGIN { $_ = 'foo'; } # because Symbol used to clobber $_ @@ -26,6 +26,27 @@ ungensym $sym1; $sym1 = $sym2 = undef; +# Test geniosym() + +use Symbol qw(geniosym); + +$sym1 = geniosym; +like( $sym1, qr/=IO\(/, 'got an IO ref' ); + +$FOO = 'Eymascalar'; +*FOO = $sym1; + +is( $sym1, *FOO{IO}, 'assigns into glob OK' ); + +is( $FOO, 'Eymascalar', 'leaves scalar alone' ); + +{ + local $^W=1; # 5.005 compat. + my $warn; + local $SIG{__WARN__} = sub { $warn .= "@_" }; + readline FOO; + like( $warn, qr/unopened filehandle/, 'warns like an unopened filehandle' ); +} # Test qualify() package foo; |