← 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:11:22 2013

Filename/usr/lib/perl/5.10/re.pm
StatementsExecuted 41 statements in 1.13ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21134µs34µsre::::bitsre::bits
22229µs63µsre::::importre::import
11119µs24µsre::::BEGIN@4re::BEGIN@4
11110µs25µsre::::BEGIN@5re::BEGIN@5
0000s0sre::::_do_installre::_do_install
0000s0sre::::_load_unloadre::_load_unload
0000s0sre::::setcolorre::setcolor
0000s0sre::::unimportre::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package re;
2
3# pragma for controlling the regex engine
4329µs228µs
# spent 24µs (19+5) within re::BEGIN@4 which was called: # once (19µs+5µs) by File::Basename::BEGIN@43 at line 4
use strict;
# spent 24µs making 1 call to re::BEGIN@4 # spent 5µs making 1 call to strict::import
53969µs240µs
# spent 25µs (10+15) within re::BEGIN@5 which was called: # once (10µs+15µs) by File::Basename::BEGIN@43 at line 5
use warnings;
# spent 25µs making 1 call to re::BEGIN@5 # spent 15µs making 1 call to warnings::import
6
71800nsour $VERSION = "0.09";
8110µsour @ISA = qw(Exporter);
91800nsmy @XS_FUNCTIONS = qw(regmust);
1013µsmy %XS_FUNCTIONS = map { $_ => 1 } @XS_FUNCTIONS;
1111µsour @EXPORT_OK = (@XS_FUNCTIONS,
12 qw(is_regexp regexp_pattern
13 regname regnames regnames_count));
1416µsour %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
15
16# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
17#
18# If you modify these values see comment below!
19
2011µsmy %bitmask = (
21 taint => 0x00100000, # HINT_RE_TAINT
22 eval => 0x00200000, # HINT_RE_EVAL
23);
24
25# - File::Basename contains a literal for 'taint' as a fallback. If
26# taint is changed here, File::Basename must be updated as well.
27#
28# - ExtUtils::ParseXS uses a hardcoded
29# BEGIN { $^H |= 0x00200000 }
30# in it to allow re.xs to be built. So if 'eval' is changed here then
31# ExtUtils::ParseXS must be changed as well.
32#
33# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
34
35sub setcolor {
36 eval { # Ignore errors
37 require Term::Cap;
38
39 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
40 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
41 my @props = split /,/, $props;
42 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
43
44 $colors =~ s/\0//g;
45 $ENV{PERL_RE_COLORS} = $colors;
46 };
47 if ($@) {
48 $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
49 }
50
51}
52
53114µsmy %flags = (
54 COMPILE => 0x0000FF,
55 PARSE => 0x000001,
56 OPTIMISE => 0x000002,
57 TRIEC => 0x000004,
58 DUMP => 0x000008,
59 FLAGS => 0x000010,
60
61 EXECUTE => 0x00FF00,
62 INTUIT => 0x000100,
63 MATCH => 0x000200,
64 TRIEE => 0x000400,
65
66 EXTRA => 0xFF0000,
67 TRIEM => 0x010000,
68 OFFSETS => 0x020000,
69 OFFSETSDBG => 0x040000,
70 STATE => 0x080000,
71 OPTIMISEM => 0x100000,
72 STACK => 0x280000,
73 BUFFERS => 0x400000,
74);
7513µs$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
7611µs$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
771900ns$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE};
7812µs$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
791900ns$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
801900ns$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
81
821300nsmy $installed;
831200nsmy $installed_error;
84
85sub _do_install {
86 if ( ! defined($installed) ) {
87 require XSLoader;
88 $installed = eval { XSLoader::load('re', $VERSION) } || 0;
89 $installed_error = $@;
90 }
91}
92
93sub _load_unload {
94 my ($on)= @_;
95 if ($on) {
96 _do_install();
97 if ( ! $installed ) {
98 die "'re' not installed!? ($installed_error)";
99 } else {
100 # We call install() every time, as if we didn't, we wouldn't
101 # "see" any changes to the color environment var since
102 # the last time it was called.
103
104 # install() returns an integer, which if casted properly
105 # in C resolves to a structure containing the regex
106 # hooks. Setting it to a random integer will guarantee
107 # segfaults.
108 $^H{regcomp} = install();
109 }
110 } else {
111 delete $^H{regcomp};
112 }
113}
114
115
# spent 34µs within re::bits which was called 2 times, avg 17µs/call: # 2 times (34µs+0s) by re::import at line 171, avg 17µs/call
sub bits {
1161448µs my $on = shift;
117 my $bits = 0;
118 unless (@_) {
119 require Carp;
120 Carp::carp("Useless use of \"re\" pragma");
121 }
122 foreach my $idx (0..$#_){
123 my $s=$_[$idx];
124 if ($s eq 'Debug' or $s eq 'Debugcolor') {
125 setcolor() if $s =~/color/i;
126 ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
127 for my $idx ($idx+1..$#_) {
128 if ($flags{$_[$idx]}) {
129 if ($on) {
130 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
131 } else {
132 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
133 }
134 } else {
135 require Carp;
136 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
137 join(", ",sort keys %flags ) );
138 }
139 }
140 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
141 last;
142 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
143 setcolor() if $s =~/color/i;
144 _load_unload($on);
145 last;
146 } elsif (exists $bitmask{$s}) {
147 $bits |= $bitmask{$s};
148 } elsif ($XS_FUNCTIONS{$s}) {
149 _do_install();
150 if (! $installed) {
151 require Carp;
152 Carp::croak("\"re\" function '$s' not available");
153 }
154 require Exporter;
155 re->export_to_level(2, 're', $s);
156 } elsif ($EXPORT_OK{$s}) {
157 require Exporter;
158 re->export_to_level(2, 're', $s);
159 } else {
160 require Carp;
161 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
162 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
163 ")");
164 }
165 }
166 $bits;
167}
168
169
# spent 63µs (29+34) within re::import which was called 2 times, avg 32µs/call: # once (18µs+24µs) by B::Deparse::BEGIN@3413 at line 3413 of B/Deparse.pm # once (11µs+10µs) by File::Basename::BEGIN@43 at line 46 of File/Basename.pm
sub import {
170422µs shift;
171234µs $^H |= bits(1, @_);
# spent 34µs making 2 calls to re::bits, avg 17µs/call
172}
173
174sub unimport {
175 shift;
176 $^H &= ~ bits(0, @_);
177}
178
179119µs1;
180
181__END__