1package Symbol; 2 3=head1 NAME 4 5Symbol - manipulate Perl symbols and their names 6 7=head1 SYNOPSIS 8 9 use Symbol; 10 11 $sym = gensym; 12 open($sym, "filename"); 13 $_ = <$sym>; 14 # etc. 15 16 ungensym $sym; # no effect 17 18 print qualify("x"), "\n"; # "Test::x" 19 print qualify("x", "FOO"), "\n" # "FOO::x" 20 print qualify("BAR::x"), "\n"; # "BAR::x" 21 print qualify("BAR::x", "FOO"), "\n"; # "BAR::x" 22 print qualify("STDOUT", "FOO"), "\n"; # "main::STDOUT" (global) 23 print qualify(\*x), "\n"; # returns \*x 24 print qualify(\*x, "FOO"), "\n"; # returns \*x 25 26 use strict refs; 27 print { qualify_to_ref $fh } "foo!\n"; 28 $ref = qualify_to_ref $name, $pkg; 29 30=head1 DESCRIPTION 31 32C<Symbol::gensym> creates an anonymous glob and returns a reference 33to it. Such a glob reference can be used as a file or directory 34handle. 35 36For backward compatibility with older implementations that didn't 37support anonymous globs, C<Symbol::ungensym> is also provided. 38But it doesn't do anything. 39 40C<Symbol::qualify> turns unqualified symbol names into qualified 41variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a 42second parameter, C<qualify> uses it as the default package; 43otherwise, it uses the package of its caller. Regardless, global 44variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with 45"main::". 46 47Qualification applies only to symbol names (strings). References are 48left unchanged under the assumption that they are glob references, 49which are qualified by their nature. 50 51C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it 52returns a glob ref rather than a symbol name, so you can use the result 53even if C<use strict 'refs'> is in effect. 54 55=cut 56 57BEGIN { require 5.002; } 58 59require Exporter; 60@ISA = qw(Exporter); 61@EXPORT = qw(gensym ungensym qualify qualify_to_ref); 62 63$VERSION = 1.02; 64 65my $genpkg = "Symbol::"; 66my $genseq = 0; 67 68my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT); 69 70# 71# Note that we never _copy_ the glob; we just make a ref to it. 72# If we did copy it, then SVf_FAKE would be set on the copy, and 73# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work. 74# 75sub gensym () { 76 my $name = "GEN" . $genseq++; 77 my $ref = \*{$genpkg . $name}; 78 delete $$genpkg{$name}; 79 $ref; 80} 81 82sub ungensym ($) {} 83 84sub qualify ($;$) { 85 my ($name) = @_; 86 if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) { 87 my $pkg; 88 # Global names: special character, "^x", or other. 89 if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) { 90 $pkg = "main"; 91 } 92 else { 93 $pkg = (@_ > 1) ? $_[1] : caller; 94 } 95 $name = $pkg . "::" . $name; 96 } 97 $name; 98} 99 100sub qualify_to_ref ($;$) { 101 return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; 102} 103 1041; 105