← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:49 2013

Filename/usr/share/perl/5.10/Symbol.pm
StatementsExecuted 146 statements in 1.23ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
3433357µs357µsSymbol::::gensymSymbol::gensym
11132µs32µsSymbol::::BEGIN@3Symbol::BEGIN@3
0000s0sSymbol::::delete_packageSymbol::delete_package
0000s0sSymbol::::geniosymSymbol::geniosym
0000s0sSymbol::::qualifySymbol::qualify
0000s0sSymbol::::qualify_to_refSymbol::qualify_to_ref
0000s0sSymbol::::ungensymSymbol::ungensym
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Symbol;
2
31799µs132µ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
511µsrequire Exporter;
6114µs@ISA = qw(Exporter);
712µs@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
811µs@EXPORT_OK = qw(delete_package geniosym);
9
101600ns$VERSION = '1.07';
11
121700nsmy $genpkg = "Symbol::";
131400nsmy $genseq = 0;
14
15113µsmy %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 () {
233458µs my $name = "GEN" . $genseq++;
2434151µs my $ref = \*{$genpkg . $name};
253448µs delete $$genpkg{$name};
2634133µs $ref;
27}
28
29sub geniosym () {
30 my $sym = gensym();
31 # force the IO slot to be filled
32 select(select $sym);
33 *$sym{IO};
34}
35
36sub ungensym ($) {}
37
38sub 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
56sub qualify_to_ref ($;$) {
57 return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
58}
59
60#
61# of Safe.pm lineage
62#
63sub 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
91112µs1;