Profile of Symbol.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/Symbol.pm
Statements	Executed 21 statements in 880µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	28µs	31µs	Symbol::::BEGIN@3Symbol::BEGIN@3
1	1	1	10µs	16µs	Symbol::::BEGIN@103Symbol::BEGIN@103
1	1	1	7µs	12µs	Symbol::::BEGIN@137Symbol::BEGIN@137
1	1	1	7µs	10µs	Symbol::::BEGIN@156Symbol::BEGIN@156
1	1	1	7µs	93µs	Symbol::::BEGIN@4Symbol::BEGIN@4
1	1	1	6µs	8µ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	33µs	2	34µs	# spent 31µs (28+3) within Symbol::BEGIN@3 which was called: # once (28µs+3µs) by IO::File::BEGIN@130 at line 3 use strict; # spent 31µs making 1 call to Symbol::BEGIN@3 # spent 3µs making 1 call to strict::import
4	2	145µs	2	179µs	# spent 93µs (7+86) within Symbol::BEGIN@4 which was called: # once (7µs+86µs) by IO::File::BEGIN@130 at line 4 use warnings; # spent 93µs making 1 call to Symbol::BEGIN@4 # spent 86µ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	11µs			our @ISA = qw(Exporter);
86	1	1µs			our @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
87	1	1µs			our @EXPORT_OK = qw(delete_package geniosym);
88
89	1	0s			our $VERSION = '1.09';
90
91	1	0s			my $genpkg = "Symbol::";
92	1	0s			my $genseq = 0;
93
94	1	6µ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	312µs	2	22µs	# spent 16µs (10+6) within Symbol::BEGIN@103 which was called: # once (10µs+6µs) by IO::File::BEGIN@130 at line 103 no strict 'refs'; # spent 16µs making 1 call to Symbol::BEGIN@103 # spent 6µ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	190µs	2	17µs	# spent 12µs (7+5) within Symbol::BEGIN@137 which was called: # once (7µs+5µs) by IO::File::BEGIN@130 at line 137 no strict 'refs'; # spent 12µs making 1 call to Symbol::BEGIN@137 # spent 5µ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	64µs	2	13µs	# spent 10µs (7+3) within Symbol::BEGIN@156 which was called: # once (7µs+3µs) by IO::File::BEGIN@130 at line 156 no strict 'refs'; # spent 10µs making 1 call to Symbol::BEGIN@156 # spent 3µ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	108µs	2	10µs	# spent 8µs (6+2) within Symbol::BEGIN@167 which was called: # once (6µs+2µs) by IO::File::BEGIN@130 at line 167 use strict 'refs'; # spent 8µs making 1 call to Symbol::BEGIN@167 # spent 2µ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	8µs			1;