Profile of /usr/local/lib/perl5/5.10.1/Symbol.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:20 2010

File | /usr/local/lib/perl5/5.10.1/Symbol.pm
Statements Executed | 30
Statement Execution Time | 592µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 22µs | 22µs | Symbol::::BEGIN@81Symbol::BEGIN@81
2 | 1 | 1 | 22µs | 22µs | Symbol::::gensymSymbol::gensym
4 | 2 | 2 | 14µs | 14µs | Symbol::::qualifySymbol::qualify
0 | 0 | 0 | 0s | 0s | Symbol::::delete_packageSymbol::delete_package
0 | 0 | 0 | 0s | 0s | Symbol::::geniosymSymbol::geniosym
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 |  |  |  |  |
5 |  |  |  |  | Symbol - manipulate Perl symbols and their names
6 |  |  |  |  |
7 |  |  |  |  | =head1 SYNOPSIS
8 |  |  |  |  |
9 |  |  |  |  | use Symbol;
10 |  |  |  |  |
11 |  |  |  |  | $sym = gensym;
12 |  |  |  |  | open($sym, "filename");
13 |  |  |  |  | $_ = <$sym>;
14 |  |  |  |  | # etc.
15 |  |  |  |  |
16 |  |  |  |  | ungensym $sym; # no effect
17 |  |  |  |  |
18 |  |  |  |  | # replace *FOO{IO} handle but not $FOO, %FOO, etc.
19 |  |  |  |  | *FOO = geniosym;
20 |  |  |  |  |
21 |  |  |  |  | print qualify("x"), "\n"; # "main::x"
22 |  |  |  |  | print qualify("x", "FOO"), "\n"; # "FOO::x"
23 |  |  |  |  | print qualify("BAR::x"), "\n"; # "BAR::x"
24 |  |  |  |  | print qualify("BAR::x", "FOO"), "\n"; # "BAR::x"
25 |  |  |  |  | print qualify("STDOUT", "FOO"), "\n"; # "main::STDOUT" (global)
26 |  |  |  |  | print qualify(\*x), "\n"; # returns \*x
27 |  |  |  |  | print qualify(\*x, "FOO"), "\n"; # returns \*x
28 |  |  |  |  |
29 |  |  |  |  | use strict refs;
30 |  |  |  |  | print { qualify_to_ref $fh } "foo!\n";
31 |  |  |  |  | $ref = qualify_to_ref $name, $pkg;
32 |  |  |  |  |
33 |  |  |  |  | use Symbol qw(delete_package);
34 |  |  |  |  | delete_package('Foo::Bar');
35 |  |  |  |  | print "deleted\n" unless exists $Foo::{'Bar::'};
36 |  |  |  |  |
37 |  |  |  |  | =head1 DESCRIPTION
38 |  |  |  |  |
39 |  |  |  |  | C<Symbol::gensym> creates an anonymous glob and returns a reference
40 |  |  |  |  | to it. Such a glob reference can be used as a file or directory
41 |  |  |  |  | handle.
42 |  |  |  |  |
43 |  |  |  |  | For backward compatibility with older implementations that didn't
44 |  |  |  |  | support anonymous globs, C<Symbol::ungensym> is also provided.
45 |  |  |  |  | But it doesn't do anything.
46 |  |  |  |  |
47 |  |  |  |  | C<Symbol::geniosym> creates an anonymous IO handle. This can be
48 |  |  |  |  | assigned into an existing glob without affecting the non-IO portions
49 |  |  |  |  | of the glob.
50 |  |  |  |  |
51 |  |  |  |  | C<Symbol::qualify> turns unqualified symbol names into qualified
52 |  |  |  |  | variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a
53 |  |  |  |  | second parameter, C<qualify> uses it as the default package;
54 |  |  |  |  | otherwise, it uses the package of its caller. Regardless, global
55 |  |  |  |  | variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
56 |  |  |  |  | "main::".
57 |  |  |  |  |
58 |  |  |  |  | Qualification applies only to symbol names (strings). References are
59 |  |  |  |  | left unchanged under the assumption that they are glob references,
60 |  |  |  |  | which are qualified by their nature.
61 |  |  |  |  |
62 |  |  |  |  | C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
63 |  |  |  |  | returns a glob ref rather than a symbol name, so you can use the result
64 |  |  |  |  | even if C<use strict 'refs'> is in effect.
65 |  |  |  |  |
66 |  |  |  |  | C<Symbol::delete_package> wipes out a whole package namespace. Note
67 |  |  |  |  | this routine is not exported by default--you may want to import it
68 |  |  |  |  | explicitly.
69 |  |  |  |  |
70 |  |  |  |  | =head1 BUGS
71 |  |  |  |  |
72 |  |  |  |  | C<Symbol::delete_package> is a bit too powerful. It undefines every symbol that
73 |  |  |  |  | lives in the specified package. Since perl, for performance reasons, does not
74 |  |  |  |  | perform a symbol table lookup each time a function is called or a global
75 |  |  |  |  | variable is accessed, some code that has already been loaded and that makes use
76 |  |  |  |  | of symbols in package C<Foo> may stop working after you delete C<Foo>, even if
77 |  |  |  |  | you reload the C<Foo> module afterwards.
78 |  |  |  |  |
79 |  |  |  |  | =cut
80 |  |  |  |  |
81 | 1 | 514µs | 1 | 22µs | # spent 22µs within Symbol::BEGIN@81 which was called # once (22µs+0s) by IO::File::BEGIN@131 at line 81 BEGIN { require 5.005; } # spent 22µs making 1 call to Symbol::BEGIN@81
82 |  |  |  |  |
83 | 1 | 2µs |  |  | require Exporter;
84 | 1 | 9µs |  |  | @ISA = qw(Exporter);
85 | 1 | 1µs |  |  | @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
86 | 1 | 500ns |  |  | @EXPORT_OK = qw(delete_package geniosym);
87 |  |  |  |  |
88 | 1 | 300ns |  |  | $VERSION = '1.07';
89 |  |  |  |  |
90 | 1 | 300ns |  |  | my $genpkg = "Symbol::";
91 | 1 | 100ns |  |  | my $genseq = 0;
92 |  |  |  |  |
93 | 1 | 10µ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 |  |  |  |  | # spent 22µs within Symbol::gensym which was called 2 times, avg 11µs/call: # 2 times (22µs+0s) by IO::Handle::new at line 313 of IO/Handle.pm, avg 11µs/call sub gensym () {
101 | 2 | 4µs |  |  | my $name = "GEN" . $genseq++;
102 | 2 | 10µs |  |  | my $ref = \*{$genpkg . $name};
103 | 2 | 2µs |  |  | delete $$genpkg{$name};
104 | 2 | 7µs |  |  | $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 |  |  |  |  | # spent 14µs within Symbol::qualify which was called 4 times, avg 3µs/call: # 2 times (10µs+0s) by IO::Handle::autoflush at line 479 of IO/Handle.pm, avg 5µs/call # 2 times (4µs+0s) by SelectSaver::new at line 45 of SelectSaver.pm, avg 2µs/call sub qualify ($;$) {
117 | 4 | 2µs |  |  | my ($name) = @_;
118 | 4 | 3µs |  |  | 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 | 4 | 12µs |  |  | $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 | 14µs |  |  | 1;