Commit | Line | Data |
---|---|---|
c07a80fd | 1 | package Symbol; |
2 | ||
3 | =head1 NAME | |
4 | ||
5 | Symbol - 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 | ||
b42fedfb CS |
26 | use strict refs; |
27 | print { qualify_to_ref $fh } "foo!\n"; | |
28 | $ref = qualify_to_ref $name, $pkg; | |
29 | ||
c07a80fd | 30 | =head1 DESCRIPTION |
31 | ||
32 | C<Symbol::gensym> creates an anonymous glob and returns a reference | |
33 | to it. Such a glob reference can be used as a file or directory | |
34 | handle. | |
35 | ||
36 | For backward compatibility with older implementations that didn't | |
37 | support anonymous globs, C<Symbol::ungensym> is also provided. | |
38 | But it doesn't do anything. | |
39 | ||
40 | C<Symbol::qualify> turns unqualified symbol names into qualified | |
7c584b33 | 41 | variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a |
c07a80fd | 42 | second parameter, C<qualify> uses it as the default package; |
43 | otherwise, it uses the package of its caller. Regardless, global | |
44 | variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with | |
45 | "main::". | |
46 | ||
47 | Qualification applies only to symbol names (strings). References are | |
48 | left unchanged under the assumption that they are glob references, | |
49 | which are qualified by their nature. | |
50 | ||
b42fedfb CS |
51 | C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it |
52 | returns a glob ref rather than a symbol name, so you can use the result | |
53 | even if C<use strict 'refs'> is in effect. | |
54 | ||
c07a80fd | 55 | =cut |
56 | ||
3dc8e7ab | 57 | BEGIN { require 5.002; } |
c07a80fd | 58 | |
59 | require Exporter; | |
60 | @ISA = qw(Exporter); | |
b42fedfb | 61 | @EXPORT = qw(gensym ungensym qualify qualify_to_ref); |
c07a80fd | 62 | |
b42fedfb | 63 | $VERSION = 1.02; |
c07a80fd | 64 | |
65 | my $genpkg = "Symbol::"; | |
66 | my $genseq = 0; | |
67 | ||
7c584b33 | 68 | my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT); |
c07a80fd | 69 | |
6adf1df6 JH |
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 | # | |
c07a80fd | 75 | sub gensym () { |
76 | my $name = "GEN" . $genseq++; | |
6adf1df6 JH |
77 | my $ref = \*{$genpkg . $name}; |
78 | delete $$genpkg{$name}; | |
79 | $ref; | |
c07a80fd | 80 | } |
81 | ||
82 | sub ungensym ($) {} | |
83 | ||
84 | sub qualify ($;$) { | |
85 | my ($name) = @_; | |
49da0595 | 86 | if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) { |
c07a80fd | 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 | ||
b42fedfb CS |
100 | sub qualify_to_ref ($;$) { |
101 | return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; | |
102 | } | |
103 | ||
c07a80fd | 104 | 1; |