Profile of Date/Parse.pm

Filename	/usr/share/perl5/Date/Parse.pm
Statements	Executed 37 statements in 2.06ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	1.39ms	1.75ms	Date::Parse::::BEGIN@12Date::Parse::BEGIN@12
1	1	1	1.09ms	1.11ms	Date::Parse::::gen_parserDate::Parse::gen_parser
1	1	1	24µs	51µs	Date::Parse::::BEGIN@13Date::Parse::BEGIN@13
1	1	1	20µs	24µs	Date::Parse::::BEGIN@8Date::Parse::BEGIN@8
3	3	1	18µs	18µs	Date::Parse::::CORE:sortDate::Parse::CORE:sort (opcode)
1	1	1	16µs	58µs	Date::Parse::::BEGIN@10Date::Parse::BEGIN@10
1	1	1	12µs	59µs	Date::Parse::::BEGIN@11Date::Parse::BEGIN@11
1	1	1	11µs	69µs	Date::Parse::::BEGIN@207Date::Parse::BEGIN@207
1	1	1	8µs	57µs	Date::Parse::::BEGIN@9Date::Parse::BEGIN@9
0	0	0	0s	0s	Date::Parse::::__ANON__[:263]Date::Parse::__ANON__[:263]
0	0	0	0s	0s	Date::Parse::::__ANON__[:275]Date::Parse::__ANON__[:275]
0	0	0	0s	0s	Date::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
5					package Date::Parse;
6
7	1	16µs			require 5.000;
8	3	34µs	2	28µ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
9	3	28µs	2	106µ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
10	3	33µs	2	99µ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
11	3	32µs	2	107µ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
12	3	179µs	2	1.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
13	3	271µs	2	79µ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
15	1	8µs			@ISA = qw(Exporter);
16	1	800ns			@EXPORT = qw(&strtotime &str2time &strptime);
17
18	1	400ns			$VERSION = "2.30";
19
20	1	8µs			my %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
36	1	7µs			my %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
50	1	5µs			my @suf = (qw(th st nd rd th th th th th th)) x 3;
51	1	1µs			@suf[11,12,13] = qw(th th th);
52
53					#Abbreviations
54
55	1	15µs			map { $month{substr($_,0,3)} = $month{$_} } keys %month;
56	1	14µs			map { $day{substr($_,0,3)} = $day{$_} } keys %day;
57
58	1	3µs			my $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
71					sub {
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					}
205					ESQ
206
207	3	371µs	2	128µ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
209					sub 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 {
211	3	1.00ms			local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
212
213					if($obj)
214					{
215					my $obj_strptime = $strptime;
216					substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
217					shift; # package
218					ESQ
219					my $sub = eval "$obj_strptime" or die $@;
220					return $sub;
221					}
222
223					eval "$strptime" or die $@; # spent 109µs executing statements in string eval
224
225					}
226
227	1	4µs	1	1.11ms	*strptime = gen_parser(\%day,\%month,\@suf); # spent 1.11ms making 1 call to Date::Parse::gen_parser
228
229					sub 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
288	1	21µs			1;
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