diff options
author | Yitzchak Scott-Thoennes <sthoenna@efn.org> | 2002-02-25 07:04:57 -0800 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-02-26 01:01:13 +0000 |
commit | ae716a98930f0a80b96ee5d383780578d69d0830 (patch) | |
tree | c182c19694d8914c09ea20973f4634046ed4eec0 /lib | |
parent | e48df184541995015048bca83e39a89859aa31ce (diff) | |
download | perl-ae716a98930f0a80b96ee5d383780578d69d0830.tar.gz |
Perl interface to newIO()
Message-ID: <ZMse8gzkg6oQ092yn@efn.org>
p4raw-id: //depot/perl@14878
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; |