Profile of Symbol.pm

Filename	/usr/share/perl/5.10/Symbol.pm
Statements	Executed 146 statements in 1.23ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
34	3	3	357µs	357µs	Symbol::::gensymSymbol::gensym
1	1	1	32µs	32µs	Symbol::::BEGIN@3Symbol::BEGIN@3
0	0	0	0s	0s	Symbol::::delete_packageSymbol::delete_package
0	0	0	0s	0s	Symbol::::geniosymSymbol::geniosym
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	1	799µs	1	32µs	# spent 32µs within Symbol::BEGIN@3 which was called: # once (32µs+0s) by IO::File::BEGIN@9 at line 3 BEGIN { require 5.005; } # spent 32µs making 1 call to Symbol::BEGIN@3
4
5	1	1µs			require Exporter;
6	1	14µs			@ISA = qw(Exporter);
7	1	2µs			@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
8	1	1µs			@EXPORT_OK = qw(delete_package geniosym);
9
10	1	600ns			$VERSION = '1.07';
11
12	1	700ns			my $genpkg = "Symbol::";
13	1	400ns			my $genseq = 0;
14
15	1	13µs			my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
16
17					#
18					# Note that we never _copy_ the glob; we just make a ref to it.
19					# If we did copy it, then SVf_FAKE would be set on the copy, and
20					# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
21					#
22					# spent 357µs within Symbol::gensym which was called 34 times, avg 10µs/call: # 30 times (286µs+0s) by XML::SAX::ParserFactory::_parser_class at line 83 of XML/SAX/ParserFactory.pm, avg 10µs/call # 3 times (52µs+0s) by IO::Handle::new at line 56 of IO/Handle.pm, avg 17µs/call # once (18µs+0s) by XML::SAX::load_parsers at line 60 of XML/SAX.pm sub gensym () {
23	136	389µs			my $name = "GEN" . $genseq++;
24					my $ref = \*{$genpkg . $name};
25					delete $$genpkg{$name};
26					$ref;
27					}
28
29					sub geniosym () {
30					my $sym = gensym();
31					# force the IO slot to be filled
32					select(select $sym);
33					*$sym{IO};
34					}
35
36					sub ungensym ($) {}
37
38					sub qualify ($;$) {
39					my ($name) = @_;
40					if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
41					my $pkg;
42					# Global names: special character, "^xyz", or other.
43					if ($name =~ /^(([^a-z])\|(\^[a-z_]+))\z/i \|\| $global{$name}) {
44					# RGS 2001-11-05 : translate leading ^X to control-char
45					$name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei;
46					$pkg = "main";
47					}
48					else {
49					$pkg = (@_ > 1) ? $_[1] : caller;
50					}
51					$name = $pkg . "::" . $name;
52					}
53					$name;
54					}
55
56					sub qualify_to_ref ($;$) {
57					return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
58					}
59
60					#
61					# of Safe.pm lineage
62					#
63					sub delete_package ($) {
64					my $pkg = shift;
65
66					# expand to full symbol table name if needed
67
68					unless ($pkg =~ /^main::.*::$/) {
69					$pkg = "main$pkg" if $pkg =~ /^::/;
70					$pkg = "main::$pkg" unless $pkg =~ /^main::/;
71					$pkg .= '::' unless $pkg =~ /::$/;
72					}
73
74					my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
75					my $stem_symtab = *{$stem}{HASH};
76					return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
77
78					# free all the symbols in the package
79
80					my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
81					foreach my $name (keys %$leaf_symtab) {
82					undef *{$pkg . $name};
83					}
84
85					# delete the symbol table
86
87					%$leaf_symtab = ();
88					delete $stem_symtab->{$leaf};
89					}
90
91	1	12µs			1;