Filename	/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/5.10.1/Symbol.pm
Statements	Executed 10 statements in 2.09ms

Subroutines

Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	94µs	94µs	Symbol::::BEGIN@81Symbol::BEGIN@81
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					=head1 NAME
4
- -
81	1	1.90ms	1	94µs	# spent 94µs within Symbol::BEGIN@81 which was called: # once (94µs+0s) by IO::Handle::BEGIN@264 at line 81 BEGIN { require 5.005; } # spent 94µs making 1 call to Symbol::BEGIN@81
82
83	1	4µs			require Exporter;
84	1	36µs			@ISA = qw(Exporter);
85	1	6µs			@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
86	1	5µs			@EXPORT_OK = qw(delete_package geniosym);
87
88	1	3µs			$VERSION = '1.07';
89
90	1	4µs			my $genpkg = "Symbol::";
91	1	68µs			my $genseq = 0;
92
93	1	34µs			my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
94
95					#
96					# Note that we never _copy_ the glob; we just make a ref to it.
97					# If we did copy it, then SVf_FAKE would be set on the copy, and
98					# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
99					#
100					sub gensym () {
101					my $name = "GEN" . $genseq++;
102					my $ref = \*{$genpkg . $name};
103					delete $$genpkg{$name};
104					$ref;
105					}
106
107					sub geniosym () {
108					my $sym = gensym();
109					# force the IO slot to be filled
110					select(select $sym);
111					*$sym{IO};
112					}
113
114					sub ungensym ($) {}
115
116					sub qualify ($;$) {
117					my ($name) = @_;
118					if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
119					my $pkg;
120					# Global names: special character, "^xyz", or other.
121					if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) {
122					# RGS 2001-11-05 : translate leading ^X to control-char
123					$name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei;
124					$pkg = "main";
125					}
126					else {
127					$pkg = (@_ > 1) ? $_[1] : caller;
128					}
129					$name = $pkg . "::" . $name;
130					}
131					$name;
132					}
133
134					sub qualify_to_ref ($;$) {
135					return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
136					}
137
138					#
139					# of Safe.pm lineage
140					#
141					sub delete_package ($) {
142					my $pkg = shift;
143
144					# expand to full symbol table name if needed
145
146					unless ($pkg =~ /^main::.*::$/) {
147					$pkg = "main$pkg" if $pkg =~ /^::/;
148					$pkg = "main::$pkg" unless $pkg =~ /^main::/;
149					$pkg .= '::' unless $pkg =~ /::$/;
150					}
151
152					my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
153					my $stem_symtab = *{$stem}{HASH};
154					return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
155
156
157					# free all the symbols in the package
158
159					my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
160					foreach my $name (keys %$leaf_symtab) {
161					undef *{$pkg . $name};
162					}
163
164					# delete the symbol table
165
166					%$leaf_symtab = ();
167					delete $stem_symtab->{$leaf};
168					}
169
170	1	28µs			1;