Profile of Symbol.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/5.38.2/Symbol.pm
Statements | Executed 57 statements in 619µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
9 | 1 | 1 | 32µs | 32µs | Symbol::::gensymSymbol::gensym
1 | 1 | 1 | 8µs | 10µs | Symbol::::BEGIN@3Symbol::BEGIN@3
1 | 1 | 1 | 8µs | 23µs | Symbol::::BEGIN@4Symbol::BEGIN@4
1 | 1 | 1 | 6µs | 10µs | Symbol::::BEGIN@137Symbol::BEGIN@137
1 | 1 | 1 | 6µs | 10µs | Symbol::::BEGIN@156Symbol::BEGIN@156
1 | 1 | 1 | 5µs | 11µs | Symbol::::BEGIN@103Symbol::BEGIN@103
1 | 1 | 1 | 5µs | 7µ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::::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 | 16µs | 2 | 11µs | # spent 10µs (8+1) within Symbol::BEGIN@3 which was called: # once (8µs+1µs) by IO::File::BEGIN@122 at line 3 use strict; # spent 10µs making 1 call to Symbol::BEGIN@3 # spent 1µs making 1 call to strict::import
4 | 2 | 94µs | 2 | 39µs | # spent 23µs (8+15) within Symbol::BEGIN@4 which was called: # once (8µs+15µs) by IO::File::BEGIN@122 at line 4 use warnings; # spent 23µs making 1 call to Symbol::BEGIN@4 # spent 15µ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 | 300ns |  |  | require Exporter;
85 | 1 | 5µs |  |  | our @ISA = qw(Exporter);
86 | 1 | 500ns |  |  | our @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
87 | 1 | 200ns |  |  | our @EXPORT_OK = qw(delete_package geniosym);
88 |  |  |  |  |
89 | 1 | 200ns |  |  | our $VERSION = '1.09';
90 |  |  |  |  |
91 | 1 | 200ns |  |  | my $genpkg = "Symbol::";
92 | 1 | 100ns |  |  | my $genseq = 0;
93 |  |  |  |  |
94 | 1 | 3µ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 |  |  |  |  | # spent 32µs within Symbol::gensym which was called 9 times, avg 4µs/call: # 9 times (32µs+0s) by IO::Handle::new at line 333 of IO/Handle.pm, avg 4µs/call sub gensym () {
102 | 9 | 5µs |  |  | my $name = "GEN" . $genseq++;
103 | 2 | 199µs | 2 | 17µs | # spent 11µs (5+6) within Symbol::BEGIN@103 which was called: # once (5µs+6µs) by IO::File::BEGIN@122 at line 103 no strict 'refs'; # spent 11µs making 1 call to Symbol::BEGIN@103 # spent 6µs making 1 call to strict::unimport
104 | 9 | 16µs |  |  | my $ref = \*{$genpkg . $name};
105 | 9 | 5µs |  |  | delete $$genpkg{$name};
106 | 9 | 11µs |  |  | $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 | 160µs | 2 | 14µs | # spent 10µs (6+4) within Symbol::BEGIN@137 which was called: # once (6µs+4µs) by IO::File::BEGIN@122 at line 137 no strict 'refs'; # spent 10µs making 1 call to Symbol::BEGIN@137 # spent 4µ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 | 50µs | 2 | 14µs | # spent 10µs (6+4) within Symbol::BEGIN@156 which was called: # once (6µs+4µs) by IO::File::BEGIN@122 at line 156 no strict 'refs'; # spent 10µs making 1 call to Symbol::BEGIN@156 # spent 4µ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 | 50µs | 2 | 10µs | # spent 7µs (5+3) within Symbol::BEGIN@167 which was called: # once (5µs+3µs) by IO::File::BEGIN@122 at line 167 use strict 'refs'; # spent 7µs making 1 call to Symbol::BEGIN@167 # spent 3µ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 | 4µs |  |  | 1;