Profile of Symbol.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/Symbol.pm
Statements	Executed 21 statements in 1.05ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	29µs	33µs	Symbol::::BEGIN@3Symbol::BEGIN@3
1	1	1	12µs	17µs	Symbol::::BEGIN@156Symbol::BEGIN@156
1	1	1	11µs	94µs	Symbol::::BEGIN@4Symbol::BEGIN@4
1	1	1	10µs	17µs	Symbol::::BEGIN@137Symbol::BEGIN@137
1	1	1	7µs	14µs	Symbol::::BEGIN@103Symbol::BEGIN@103
1	1	1	4µs	7µs	Symbol::::BEGIN@167Symbol::BEGIN@167
0	0	0	0s	0s	Symbol::::delete_packageSymbol::delete_package
0	0	0	0s	0s	Symbol::::geniosymSymbol::geniosym
0	0	0	0s	0s	Symbol::::gensymSymbol::gensym
0	0	0	0s	0s	Symbol::::qualifySymbol::qualify
0	0	0	0s	0s	Symbol::::qualify_to_refSymbol::qualify_to_ref
0	0	0	0s	0s	Symbol::::ungensymSymbol::ungensym

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Symbol;
2
3	2	42µs	2	37µs	# spent 33µs (29+4) within Symbol::BEGIN@3 which was called: # once (29µs+4µs) by IO::File::BEGIN@130 at line 3 use strict; # spent 33µs making 1 call to Symbol::BEGIN@3 # spent 4µs making 1 call to strict::import
4	2	171µs	2	177µs	# spent 94µs (11+83) within Symbol::BEGIN@4 which was called: # once (11µs+83µs) by IO::File::BEGIN@130 at line 4 use warnings; # spent 94µs making 1 call to Symbol::BEGIN@4 # spent 83µs making 1 call to warnings::import
5
6					=head1 NAME
7
8					Symbol - manipulate Perl symbols and their names
9
10					=head1 SYNOPSIS
11
12					use Symbol;
13
14					$sym = gensym;
15					open($sym, '<', "filename");
16					$_ = <$sym>;
17					# etc.
18
19					ungensym $sym; # no effect
20
21					# replace *FOO{IO} handle but not $FOO, %FOO, etc.
22					*FOO = geniosym;
23
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
31
32					use strict refs;
33					print { qualify_to_ref $fh } "foo!\n";
34					$ref = qualify_to_ref $name, $pkg;
35
36					use Symbol qw(delete_package);
37					delete_package('Foo::Bar');
38					print "deleted\n" unless exists $Foo::{'Bar::'};
39
40					=head1 DESCRIPTION
41
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
44					handle.
45
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.
49
50					C<Symbol::geniosym> creates an anonymous IO handle. This can be
51					assigned into an existing glob without affecting the non-IO portions
52					of the glob.
53
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
59					"main::".
60
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.
64
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.
68
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
71					explicitly.
72
73					=head1 BUGS
74
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.
81
82					=cut
83
84	1	1µs			require Exporter;
85	1	8µs			our @ISA = qw(Exporter);
86	1	0s			our @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
87	1	0s			our @EXPORT_OK = qw(delete_package geniosym);
88
89	1	0s			our $VERSION = '1.09';
90
91	1	1µs			my $genpkg = "Symbol::";
92	1	0s			my $genseq = 0;
93
94	1	8µs			my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
95
96					#
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.
100					#
101					sub gensym () {
102					my $name = "GEN" . $genseq++;
103	2	406µs	2	21µs	# spent 14µs (7+7) within Symbol::BEGIN@103 which was called: # once (7µs+7µs) by IO::File::BEGIN@130 at line 103 no strict 'refs'; # spent 14µs making 1 call to Symbol::BEGIN@103 # spent 7µs making 1 call to strict::unimport
104					my $ref = \*{$genpkg . $name};
105					delete $$genpkg{$name};
106					$ref;
107					}
108
109					sub geniosym () {
110					my $sym = gensym();
111					# force the IO slot to be filled
112					select(select $sym);
113					*$sym{IO};
114					}
115
116					sub ungensym ($) {}
117
118					sub qualify ($;$) {
119					my ($name) = @_;
120					if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
121					my $pkg;
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;
126					$pkg = "main";
127					}
128					else {
129					$pkg = (@_ > 1) ? $_[1] : caller;
130					}
131					$name = $pkg . "::" . $name;
132					}
133					$name;
134					}
135
136					sub qualify_to_ref ($;$) {
137	2	248µs	2	24µs	# spent 17µs (10+7) within Symbol::BEGIN@137 which was called: # once (10µs+7µs) by IO::File::BEGIN@130 at line 137 no strict 'refs'; # spent 17µs making 1 call to Symbol::BEGIN@137 # spent 7µs making 1 call to strict::unimport
138					return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
139					}
140
141					#
142					# of Safe.pm lineage
143					#
144					sub delete_package ($) {
145					my $pkg = shift;
146
147					# expand to full symbol table name if needed
148
149					unless ($pkg =~ /^main::.*::$/) {
150					$pkg = "main$pkg" if $pkg =~ /^::/;
151					$pkg = "main::$pkg" unless $pkg =~ /^main::/;
152					$pkg .= '::' unless $pkg =~ /::$/;
153					}
154
155					my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
156	2	61µs	2	22µs	# spent 17µs (12+5) within Symbol::BEGIN@156 which was called: # once (12µs+5µs) by IO::File::BEGIN@130 at line 156 no strict 'refs'; # spent 17µs making 1 call to Symbol::BEGIN@156 # spent 5µs making 1 call to strict::unimport
157					my $stem_symtab = *{$stem}{HASH};
158					return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
159
160
161					# free all the symbols in the package
162
163					my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
164					foreach my $name (keys %$leaf_symtab) {
165					undef *{$pkg . $name};
166					}
167	2	100µs	2	10µs	# spent 7µs (4+3) within Symbol::BEGIN@167 which was called: # once (4µs+3µs) by IO::File::BEGIN@130 at line 167 use strict 'refs'; # spent 7µs making 1 call to Symbol::BEGIN@167 # spent 3µs making 1 call to strict::import
168
169					# delete the symbol table
170
171					%$leaf_symtab = ();
172					delete $stem_symtab->{$leaf};
173					}
174
175	1	5µs			1;