← 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:44 2013

Filename/usr/share/perl5/Date/Parse.pm
StatementsExecuted 37 statements in 2.06ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.39ms1.75msDate::Parse::::BEGIN@12Date::Parse::BEGIN@12
1111.09ms1.11msDate::Parse::::gen_parserDate::Parse::gen_parser
11124µs51µsDate::Parse::::BEGIN@13Date::Parse::BEGIN@13
11120µs24µsDate::Parse::::BEGIN@8Date::Parse::BEGIN@8
33118µs18µsDate::Parse::::CORE:sortDate::Parse::CORE:sort (opcode)
11116µs58µsDate::Parse::::BEGIN@10Date::Parse::BEGIN@10
11112µs59µsDate::Parse::::BEGIN@11Date::Parse::BEGIN@11
11111µs69µsDate::Parse::::BEGIN@207Date::Parse::BEGIN@207
1118µs57µsDate::Parse::::BEGIN@9Date::Parse::BEGIN@9
0000s0sDate::Parse::::__ANON__[:263]Date::Parse::__ANON__[:263]
0000s0sDate::Parse::::__ANON__[:275]Date::Parse::__ANON__[:275]
0000s0sDate::Parse::::str2timeDate::Parse::str2time
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Copyright (c) 1995-2009 Graham Barr. This program is free
2# software; you can redistribute it and/or modify it under the same terms
3# as Perl itself.
4
5package Date::Parse;
6
7116µsrequire 5.000;
8334µs228µs
# spent 24µs (20+4) within Date::Parse::BEGIN@8 which was called: # once (20µs+4µs) by DateTime::Format::DateParse::BEGIN@14 at line 8
use strict;
# spent 24µs making 1 call to Date::Parse::BEGIN@8 # spent 4µs making 1 call to strict::import
9328µs2106µs
# spent 57µs (8+49) within Date::Parse::BEGIN@9 which was called: # once (8µs+49µs) by DateTime::Format::DateParse::BEGIN@14 at line 9
use vars qw($VERSION @ISA @EXPORT);
# spent 57µs making 1 call to Date::Parse::BEGIN@9 # spent 49µs making 1 call to vars::import
10333µs299µs
# spent 58µs (16+42) within Date::Parse::BEGIN@10 which was called: # once (16µs+42µs) by DateTime::Format::DateParse::BEGIN@14 at line 10
use Time::Local;
# spent 58µs making 1 call to Date::Parse::BEGIN@10 # spent 42µs making 1 call to Exporter::import
11332µs2107µs
# spent 59µs (12+47) within Date::Parse::BEGIN@11 which was called: # once (12µs+47µs) by DateTime::Format::DateParse::BEGIN@14 at line 11
use Carp;
# spent 59µs making 1 call to Date::Parse::BEGIN@11 # spent 48µs making 1 call to Exporter::import
123179µs21.83ms
# spent 1.75ms (1.39+358µs) within Date::Parse::BEGIN@12 which was called: # once (1.39ms+358µs) by DateTime::Format::DateParse::BEGIN@14 at line 12
use Time::Zone;
# spent 1.75ms making 1 call to Date::Parse::BEGIN@12 # spent 85µs making 1 call to Exporter::import
133271µs279µs
# spent 51µs (24+27) within Date::Parse::BEGIN@13 which was called: # once (24µs+27µs) by DateTime::Format::DateParse::BEGIN@14 at line 13
use Exporter;
# spent 51µs making 1 call to Date::Parse::BEGIN@13 # spent 27µs making 1 call to Exporter::import
14
1518µs@ISA = qw(Exporter);
161800ns@EXPORT = qw(&strtotime &str2time &strptime);
17
181400ns$VERSION = "2.30";
19
2018µsmy %month = (
21 january => 0,
22 february => 1,
23 march => 2,
24 april => 3,
25 may => 4,
26 june => 5,
27 july => 6,
28 august => 7,
29 september => 8,
30 sept => 8,
31 october => 9,
32 november => 10,
33 december => 11,
34 );
35
3617µsmy %day = (
37 sunday => 0,
38 monday => 1,
39 tuesday => 2,
40 tues => 2,
41 wednesday => 3,
42 wednes => 3,
43 thursday => 4,
44 thur => 4,
45 thurs => 4,
46 friday => 5,
47 saturday => 6,
48 );
49
5015µsmy @suf = (qw(th st nd rd th th th th th th)) x 3;
5111µs@suf[11,12,13] = qw(th th th);
52
53#Abbreviations
54
55115µsmap { $month{substr($_,0,3)} = $month{$_} } keys %month;
56114µsmap { $day{substr($_,0,3)} = $day{$_} } keys %day;
57
5813µsmy $strptime = <<'ESQ';
59 my %month = map { lc $_ } %$mon_ref;
60 my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
61 my $monpat = join("|", reverse sort keys %month);
62 my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
63
64 my %ampm = (
65 'a' => 0, # AM
66 'p' => 12, # PM
67 );
68
69 my($AM, $PM) = (0,12);
70
71sub {
72
73 my $dtstr = lc shift;
74 my $merid = 24;
75
76 my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
77
78 $zone = tz_offset(shift) if @_;
79
80 1 while $dtstr =~ s#\([^\(\)]*\)# #o;
81
82 $dtstr =~ s#(\A|\n|\Z)# #sog;
83
84 # ignore day names
85 $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
86 $dtstr =~ s/,/ /g;
87 $dtstr =~ s#($daypat)\s*(den\s)?\b# #o;
88 # Time: 12:00 or 12:00:00 with optional am/pm
89
90 return unless $dtstr =~ /\S/;
91
92 if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
93 ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
94 }
95
96 unless (defined $hh) {
97 if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?(z)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
98 ($hh,$mm,$ss) = ($1,$2,$4);
99 $zone = 0 if $5;
100 $merid = $ampm{$6} if $6;
101 }
102
103 # Time: 12 am
104
105 elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
106 ($hh,$mm,$ss) = ($1,0,0);
107 $merid = $ampm{$2};
108 }
109 }
110
111 if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
112 $merid = $ampm{$1};
113 }
114
115
116 unless (defined $year) {
117 # Date: 12-June-96 (using - . or /)
118
119 if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
120 ($month,$day) = ($month{$3},$1);
121 $year = $5 if $5;
122 }
123
124 # Date: 12-12-96 (using '-', '.' or '/' )
125
126 elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
127 ($month,$day) = ($1 - 1,$3);
128
129 if ($5) {
130 $year = $5;
131 # Possible match for 1995-01-24 (short mainframe date format);
132 ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
133 return if length($year) > 2 and $year < 1901;
134 }
135 }
136 elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
137 ($month,$day) = ($month{$3},$1);
138 }
139 elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
140 ($month,$day) = ($month{$1},$2);
141 }
142 elsif ($dtstr =~ s#($monpat)([\/-])(\d+)[\/-]# #o) {
143 ($month,$day) = ($month{$1},$3);
144 }
145
146 # Date: 961212
147
148 elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
149 ($year,$month,$day) = ($1,$2-1,$3);
150 }
151
152 $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
153
154 }
155
156 # Zone
157
158 $dst = 1 if $dtstr =~ s#\bdst\b##o;
159
160 if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
161 $dst = 1 if $2 and $2 eq 'dst';
162 $zone = tz_offset($1);
163 return unless defined $zone;
164 }
165 elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
166 my $m = defined($4) ? "$2$4" : 0;
167 my $h = "$2$3";
168 $zone = defined($1) ? tz_offset($1) : 0;
169 return unless defined $zone;
170 $zone += 60 * ($m + (60 * $h));
171 }
172
173 if ($dtstr =~ /\S/) {
174 # now for some dumb dates
175 if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
176 $zone = 0;
177 }
178 elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
179 my $m = defined($4) ? "$2$4" : 0;
180 my $h = "$2$3";
181 $zone = defined($1) ? tz_offset($1) : 0;
182 return unless defined $zone;
183 $zone += 60 * ($m + (60 * $h));
184 }
185
186 return if $dtstr =~ /\S/o;
187 }
188
189 if (defined $hh) {
190 if ($hh == 12) {
191 $hh = 0 if $merid == $AM;
192 }
193 elsif ($merid == $PM) {
194 $hh += 12;
195 }
196 }
197
198 $year -= 1900 if defined $year && $year > 1900;
199
200 $zone += 3600 if defined $zone && $dst;
201 $ss += "0.$frac" if $frac;
202
203 return ($ss,$mm,$hh,$day,$month,$year,$zone);
204}
205ESQ
206
2073371µs2128µs
# spent 69µs (11+58) within Date::Parse::BEGIN@207 which was called: # once (11µs+58µs) by DateTime::Format::DateParse::BEGIN@14 at line 207
use vars qw($day_ref $mon_ref $suf_ref $obj);
# spent 69µs making 1 call to Date::Parse::BEGIN@207 # spent 58µs making 1 call to vars::import
208
209sub gen_parser
210
# spent 1.11ms (1.09+18µs) within Date::Parse::gen_parser which was called: # once (1.09ms+18µs) by DateTime::Format::DateParse::BEGIN@14 at line 227
{
21111µs local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
212
2131400ns if($obj)
214 {
215 my $obj_strptime = $strptime;
216 substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
217 shift; # package
218ESQ
219 my $sub = eval "$obj_strptime" or die $@;
220 return $sub;
221 }
222
22311.00ms eval "$strptime" or die $@;
# spent 109µs executing statements in string eval
224
225}
226
22714µs11.11ms*strptime = gen_parser(\%day,\%month,\@suf);
# spent 1.11ms making 1 call to Date::Parse::gen_parser
228
229sub str2time
230{
231 my @t = strptime(@_);
232
233 return undef
234 unless @t;
235
236 my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
237 my @lt = localtime(time);
238
239 $hh ||= 0;
240 $mm ||= 0;
241 $ss ||= 0;
242
243 my $frac = $ss - int($ss);
244 $ss = int $ss;
245
246 $month = $lt[4]
247 unless(defined $month);
248
249 $day = $lt[3]
250 unless(defined $day);
251
252 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
253 unless(defined $year);
254
255 return undef
256 unless($month <= 11 && $day >= 1 && $day <= 31
257 && $hh <= 23 && $mm <= 59 && $ss <= 59);
258
259 my $result;
260
261 if (defined $zone) {
262 $result = eval {
263 local $SIG{__DIE__} = sub {}; # Ick!
264 timegm($ss,$mm,$hh,$day,$month,$year);
265 };
266 return undef
267 if !defined $result
268 or $result == -1
269 && join("",$ss,$mm,$hh,$day,$month,$year)
270 ne "595923311169";
271 $result -= $zone;
272 }
273 else {
274 $result = eval {
275 local $SIG{__DIE__} = sub {}; # Ick!
276 timelocal($ss,$mm,$hh,$day,$month,$year);
277 };
278 return undef
279 if !defined $result
280 or $result == -1
281 && join("",$ss,$mm,$hh,$day,$month,$year)
282 ne join("",(localtime(-1))[0..5]);
283 }
284
285 return $result + $frac;
286}
287
288121µs1;
289
290__END__
 
# spent 18µs within Date::Parse::CORE:sort which was called 3 times, avg 6µs/call: # once (8µs+0s) by Date::Parse::gen_parser at line 2 of (eval 1035)[Date/Parse.pm:223] # once (6µs+0s) by Date::Parse::gen_parser at line 3 of (eval 1035)[Date/Parse.pm:223] # once (4µs+0s) by Date::Parse::gen_parser at line 4 of (eval 1035)[Date/Parse.pm:223]
sub Date::Parse::CORE:sort; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.