Filename	/usr/share/perl/5.10/Symbol.pm
Statements	Executed 10 statements in 750µs

Subroutines

Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	34µs	34µ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::::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	1	712µs	1	34µs	# spent 34µs within Symbol::BEGIN@3 which was called: # once (34µs+0s) by IO::Handle::BEGIN@7 at line 3 BEGIN { require 5.005; } # spent 34µs making 1 call to Symbol::BEGIN@3
4
5	1	1µs			require Exporter;
6	1	10µ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	1µs			$VERSION = '1.07';
11
12	1	1µs			my $genpkg = "Symbol::";
13	1	1µs			my $genseq = 0;
14
15	1	9µ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					sub gensym () {
23					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;