1*0Sstevel@tonic-gatepackage Symbol; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate=head1 NAME 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateSymbol - manipulate Perl symbols and their names 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate=head1 SYNOPSIS 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate use Symbol; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate $sym = gensym; 12*0Sstevel@tonic-gate open($sym, "filename"); 13*0Sstevel@tonic-gate $_ = <$sym>; 14*0Sstevel@tonic-gate # etc. 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate ungensym $sym; # no effect 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate # replace *FOO{IO} handle but not $FOO, %FOO, etc. 19*0Sstevel@tonic-gate *FOO = geniosym; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gate print qualify("x"), "\n"; # "Test::x" 22*0Sstevel@tonic-gate print qualify("x", "FOO"), "\n" # "FOO::x" 23*0Sstevel@tonic-gate print qualify("BAR::x"), "\n"; # "BAR::x" 24*0Sstevel@tonic-gate print qualify("BAR::x", "FOO"), "\n"; # "BAR::x" 25*0Sstevel@tonic-gate print qualify("STDOUT", "FOO"), "\n"; # "main::STDOUT" (global) 26*0Sstevel@tonic-gate print qualify(\*x), "\n"; # returns \*x 27*0Sstevel@tonic-gate print qualify(\*x, "FOO"), "\n"; # returns \*x 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gate use strict refs; 30*0Sstevel@tonic-gate print { qualify_to_ref $fh } "foo!\n"; 31*0Sstevel@tonic-gate $ref = qualify_to_ref $name, $pkg; 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate use Symbol qw(delete_package); 34*0Sstevel@tonic-gate delete_package('Foo::Bar'); 35*0Sstevel@tonic-gate print "deleted\n" unless exists $Foo::{'Bar::'}; 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate=head1 DESCRIPTION 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gateC<Symbol::gensym> creates an anonymous glob and returns a reference 40*0Sstevel@tonic-gateto it. Such a glob reference can be used as a file or directory 41*0Sstevel@tonic-gatehandle. 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gateFor backward compatibility with older implementations that didn't 44*0Sstevel@tonic-gatesupport anonymous globs, C<Symbol::ungensym> is also provided. 45*0Sstevel@tonic-gateBut it doesn't do anything. 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateC<Symbol::geniosym> creates an anonymous IO handle. This can be 48*0Sstevel@tonic-gateassigned into an existing glob without affecting the non-IO portions 49*0Sstevel@tonic-gateof the glob. 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gateC<Symbol::qualify> turns unqualified symbol names into qualified 52*0Sstevel@tonic-gatevariable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a 53*0Sstevel@tonic-gatesecond parameter, C<qualify> uses it as the default package; 54*0Sstevel@tonic-gateotherwise, it uses the package of its caller. Regardless, global 55*0Sstevel@tonic-gatevariable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with 56*0Sstevel@tonic-gate"main::". 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gateQualification applies only to symbol names (strings). References are 59*0Sstevel@tonic-gateleft unchanged under the assumption that they are glob references, 60*0Sstevel@tonic-gatewhich are qualified by their nature. 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gateC<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it 63*0Sstevel@tonic-gatereturns a glob ref rather than a symbol name, so you can use the result 64*0Sstevel@tonic-gateeven if C<use strict 'refs'> is in effect. 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gateC<Symbol::delete_package> wipes out a whole package namespace. Note 67*0Sstevel@tonic-gatethis routine is not exported by default--you may want to import it 68*0Sstevel@tonic-gateexplicitly. 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate=head1 BUGS 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gateC<Symbol::delete_package> is a bit too powerful. It undefines every symbol 73*0Sstevel@tonic-gatethat lives in the specified package and in its sub-packages. Since perl, 74*0Sstevel@tonic-gatefor performance reasons, does not perform a symbol table lookup each time 75*0Sstevel@tonic-gatea function is called or a global variable is accessed, some code that has 76*0Sstevel@tonic-gatealready been loaded and that makes use of symbols in package C<Foo> may 77*0Sstevel@tonic-gatestop working after you delete C<Foo>, even if you reload the C<Foo> module 78*0Sstevel@tonic-gateafterwards. 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gate=cut 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gateBEGIN { require 5.005; } 83*0Sstevel@tonic-gate 84*0Sstevel@tonic-gaterequire Exporter; 85*0Sstevel@tonic-gate@ISA = qw(Exporter); 86*0Sstevel@tonic-gate@EXPORT = qw(gensym ungensym qualify qualify_to_ref); 87*0Sstevel@tonic-gate@EXPORT_OK = qw(delete_package geniosym); 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gate$VERSION = '1.05'; 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gatemy $genpkg = "Symbol::"; 92*0Sstevel@tonic-gatemy $genseq = 0; 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gatemy %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT); 95*0Sstevel@tonic-gate 96*0Sstevel@tonic-gate# 97*0Sstevel@tonic-gate# Note that we never _copy_ the glob; we just make a ref to it. 98*0Sstevel@tonic-gate# If we did copy it, then SVf_FAKE would be set on the copy, and 99*0Sstevel@tonic-gate# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work. 100*0Sstevel@tonic-gate# 101*0Sstevel@tonic-gatesub gensym () { 102*0Sstevel@tonic-gate my $name = "GEN" . $genseq++; 103*0Sstevel@tonic-gate my $ref = \*{$genpkg . $name}; 104*0Sstevel@tonic-gate delete $$genpkg{$name}; 105*0Sstevel@tonic-gate $ref; 106*0Sstevel@tonic-gate} 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gatesub geniosym () { 109*0Sstevel@tonic-gate my $sym = gensym(); 110*0Sstevel@tonic-gate # force the IO slot to be filled 111*0Sstevel@tonic-gate select(select $sym); 112*0Sstevel@tonic-gate *$sym{IO}; 113*0Sstevel@tonic-gate} 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gatesub ungensym ($) {} 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gatesub qualify ($;$) { 118*0Sstevel@tonic-gate my ($name) = @_; 119*0Sstevel@tonic-gate if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) { 120*0Sstevel@tonic-gate my $pkg; 121*0Sstevel@tonic-gate # Global names: special character, "^xyz", or other. 122*0Sstevel@tonic-gate if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) { 123*0Sstevel@tonic-gate # RGS 2001-11-05 : translate leading ^X to control-char 124*0Sstevel@tonic-gate $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei; 125*0Sstevel@tonic-gate $pkg = "main"; 126*0Sstevel@tonic-gate } 127*0Sstevel@tonic-gate else { 128*0Sstevel@tonic-gate $pkg = (@_ > 1) ? $_[1] : caller; 129*0Sstevel@tonic-gate } 130*0Sstevel@tonic-gate $name = $pkg . "::" . $name; 131*0Sstevel@tonic-gate } 132*0Sstevel@tonic-gate $name; 133*0Sstevel@tonic-gate} 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gatesub qualify_to_ref ($;$) { 136*0Sstevel@tonic-gate return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; 137*0Sstevel@tonic-gate} 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate# 140*0Sstevel@tonic-gate# of Safe.pm lineage 141*0Sstevel@tonic-gate# 142*0Sstevel@tonic-gatesub delete_package ($) { 143*0Sstevel@tonic-gate my $pkg = shift; 144*0Sstevel@tonic-gate 145*0Sstevel@tonic-gate # expand to full symbol table name if needed 146*0Sstevel@tonic-gate 147*0Sstevel@tonic-gate unless ($pkg =~ /^main::.*::$/) { 148*0Sstevel@tonic-gate $pkg = "main$pkg" if $pkg =~ /^::/; 149*0Sstevel@tonic-gate $pkg = "main::$pkg" unless $pkg =~ /^main::/; 150*0Sstevel@tonic-gate $pkg .= '::' unless $pkg =~ /::$/; 151*0Sstevel@tonic-gate } 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gate my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; 154*0Sstevel@tonic-gate my $stem_symtab = *{$stem}{HASH}; 155*0Sstevel@tonic-gate return unless defined $stem_symtab and exists $stem_symtab->{$leaf}; 156*0Sstevel@tonic-gate 157*0Sstevel@tonic-gate 158*0Sstevel@tonic-gate # free all the symbols in the package 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gate my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 161*0Sstevel@tonic-gate foreach my $name (keys %$leaf_symtab) { 162*0Sstevel@tonic-gate undef *{$pkg . $name}; 163*0Sstevel@tonic-gate } 164*0Sstevel@tonic-gate 165*0Sstevel@tonic-gate # delete the symbol table 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gate %$leaf_symtab = (); 168*0Sstevel@tonic-gate delete $stem_symtab->{$leaf}; 169*0Sstevel@tonic-gate} 170*0Sstevel@tonic-gate 171*0Sstevel@tonic-gate1; 172