8 Symbol - manipulate Perl symbols and their names
15 open($sym, '<', "filename");
19 ungensym $sym; # no effect
21 # replace *FOO{IO} handle but not $FOO, %FOO, etc.
24 print qualify("x"), "\n"; # "main::x"
25 print qualify("x", "FOO"), "\n"; # "FOO::x"
26 print qualify("BAR::x"), "\n"; # "BAR::x"
27 print qualify("BAR::x", "FOO"), "\n"; # "BAR::x"
28 print qualify("STDOUT", "FOO"), "\n"; # "main::STDOUT" (global)
29 print qualify(\*x), "\n"; # returns \*x
30 print qualify(\*x, "FOO"), "\n"; # returns \*x
33 print { qualify_to_ref $fh } "foo!\n";
34 $ref = qualify_to_ref $name, $pkg;
36 use Symbol qw(delete_package);
37 delete_package('Foo::Bar');
38 print "deleted\n" unless exists $Foo::{'Bar::'};
42 C<Symbol::gensym> creates an anonymous glob and returns a reference
43 to it. Such a glob reference can be used as a file or directory
46 For backward compatibility with older implementations that didn't
47 support anonymous globs, C<Symbol::ungensym> is also provided.
48 But it doesn't do anything.
50 C<Symbol::geniosym> creates an anonymous IO handle. This can be
51 assigned into an existing glob without affecting the non-IO portions
54 C<Symbol::qualify> turns unqualified symbol names into qualified
55 variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a
56 second parameter, C<qualify> uses it as the default package;
57 otherwise, it uses the package of its caller. Regardless, global
58 variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
61 Qualification applies only to symbol names (strings). References are
62 left unchanged under the assumption that they are glob references,
63 which are qualified by their nature.
65 C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
66 returns a glob ref rather than a symbol name, so you can use the result
67 even if C<use strict 'refs'> is in effect.
69 C<Symbol::delete_package> wipes out a whole package namespace. Note
70 this routine is not exported by default--you may want to import it
75 C<Symbol::delete_package> is a bit too powerful. It undefines every symbol that
76 lives in the specified package. Since perl, for performance reasons, does not
77 perform a symbol table lookup each time a function is called or a global
78 variable is accessed, some code that has already been loaded and that makes use
79 of symbols in package C<Foo> may stop working after you delete C<Foo>, even if
80 you reload the C<Foo> module afterwards.
85 our @ISA = qw(Exporter);
86 our @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
87 our @EXPORT_OK = qw(delete_package geniosym);
89 our $VERSION = '1.09';
91 my $genpkg = "Symbol::";
94 my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
97 # Note that we never _copy_ the glob; we just make a ref to it.
98 # If we did copy it, then SVf_FAKE would be set on the copy, and
99 # glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
102 my $name = "GEN" . $genseq++;
104 my $ref = \*{$genpkg . $name};
105 delete $$genpkg{$name};
111 # force the IO slot to be filled
120 if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
122 # Global names: special character, "^xyz", or other.
123 if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) {
124 # RGS 2001-11-05 : translate leading ^X to control-char
125 $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei;
129 $pkg = (@_ > 1) ? $_[1] : caller;
131 $name = $pkg . "::" . $name;
136 sub qualify_to_ref ($;$) {
138 return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
144 sub delete_package ($) {
147 # expand to full symbol table name if needed
149 unless ($pkg =~ /^main::.*::$/) {
150 $pkg = "main$pkg" if $pkg =~ /^::/;
151 $pkg = "main::$pkg" unless $pkg =~ /^main::/;
152 $pkg .= '::' unless $pkg =~ /::$/;
155 my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
157 my $stem_symtab = *{$stem}{HASH};
158 return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
161 # free all the symbols in the package
163 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
164 foreach my $name (keys %$leaf_symtab) {
165 undef *{$pkg . $name};
169 # delete the symbol table
172 delete $stem_symtab->{$leaf};