← 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 17:10:45 2013
Reported on Tue Oct 15 17:12:15 2013

Filename/usr/share/perl/5.10/Symbol.pm
StatementsExecuted 26 statements in 939µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
42261µs61µsSymbol::::gensymSymbol::gensym
11124µs24µ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
31826µs124µs
# spent 24µs within Symbol::BEGIN@3 which was called: # once (24µs+0s) by IO::File::BEGIN@9 at line 3
BEGIN { require 5.005; }
# spent 24µs making 1 call to Symbol::BEGIN@3
4
512µ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
101700ns$VERSION = '1.07';
11
1211µsmy $genpkg = "Symbol::";
131500nsmy $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 61µs within Symbol::gensym which was called 4 times, avg 15µs/call: # 3 times (40µs+0s) by IO::Handle::new at line 56 of IO/Handle.pm, avg 13µs/call # once (21µs+0s) by XML::SAX::load_parsers at line 60 of XML/SAX.pm
sub gensym () {
23410µs my $name = "GEN" . $genseq++;
24426µs my $ref = \*{$genpkg . $name};
2547µs delete $$genpkg{$name};
26423µ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
91113µs1;