← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:12 2021

Filename/usr/local/lib/perl5/site_perl/Date/Parse.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sDate::Parse::::BEGIN@10Date::Parse::BEGIN@10
0000s0sDate::Parse::::BEGIN@11Date::Parse::BEGIN@11
0000s0sDate::Parse::::BEGIN@12Date::Parse::BEGIN@12
0000s0sDate::Parse::::BEGIN@13Date::Parse::BEGIN@13
0000s0sDate::Parse::::BEGIN@210Date::Parse::BEGIN@210
0000s0sDate::Parse::::BEGIN@8Date::Parse::BEGIN@8
0000s0sDate::Parse::::BEGIN@9Date::Parse::BEGIN@9
0000s0sDate::Parse::::CORE:sortDate::Parse::CORE:sort (opcode)
0000s0sDate::Parse::::__ANON__[:269]Date::Parse::__ANON__[:269]
0000s0sDate::Parse::::__ANON__[:281]Date::Parse::__ANON__[:281]
0000s0sDate::Parse::::gen_parserDate::Parse::gen_parser
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
7require 5.000;
8use strict;
9use vars qw($VERSION @ISA @EXPORT);
10use Time::Local;
11use Carp;
12use Time::Zone;
13use Exporter;
14
15@ISA = qw(Exporter);
16@EXPORT = qw(&strtotime &str2time &strptime);
17
18$VERSION = "2.33";
19
20my %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
36my %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
50my @suf = (qw(th st nd rd th th th th th th)) x 3;
51@suf[11,12,13] = qw(th th th);
52
53#Abbreviations
54
55map { $month{substr($_,0,3)} = $month{$_} } keys %month;
56map { $day{substr($_,0,3)} = $day{$_} } keys %day;
57
58my $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($century,$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 if (defined $year && $year > 1900) {
199 $century = int($year / 100);
200 $year -= 1900;
201 }
202
203 $zone += 3600 if defined $zone && $dst;
204 $ss += "0.$frac" if $frac;
205
206 return ($ss,$mm,$hh,$day,$month,$year,$zone,$century);
207}
208ESQ
209
210use vars qw($day_ref $mon_ref $suf_ref $obj);
211
212sub gen_parser
213{
214 local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
215
216 if($obj)
217 {
218 my $obj_strptime = $strptime;
219 substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
220 shift; # package
221ESQ
222 my $sub = eval "$obj_strptime" or die $@;
223 return $sub;
224 }
225
226 eval "$strptime" or die $@;
# spent 0s executing statements in string eval
227
228}
229
230*strptime = gen_parser(\%day,\%month,\@suf);
231
232sub str2time
233{
234 my @t = strptime(@_);
235
236 return undef
237 unless @t;
238
239 my($ss,$mm,$hh,$day,$month,$year,$zone, $century) = @t;
240 my @lt = localtime(time);
241
242 $hh ||= 0;
243 $mm ||= 0;
244 $ss ||= 0;
245
246 my $frac = $ss - int($ss);
247 $ss = int $ss;
248
249 $month = $lt[4]
250 unless(defined $month);
251
252 $day = $lt[3]
253 unless(defined $day);
254
255 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
256 unless(defined $year);
257
258 # we were given a 4 digit year, so let's keep using those
259 $year += 1900 if defined $century;
260
261 return undef
262 unless($month <= 11 && $day >= 1 && $day <= 31
263 && $hh <= 23 && $mm <= 59 && $ss <= 59);
264
265 my $result;
266
267 if (defined $zone) {
268 $result = eval {
269 local $SIG{__DIE__} = sub {}; # Ick!
270 timegm($ss,$mm,$hh,$day,$month,$year);
271 };
272 return undef
273 if !defined $result
274 or $result == -1
275 && join("",$ss,$mm,$hh,$day,$month,$year)
276 ne "595923311169";
277 $result -= $zone;
278 }
279 else {
280 $result = eval {
281 local $SIG{__DIE__} = sub {}; # Ick!
282 timelocal($ss,$mm,$hh,$day,$month,$year);
283 };
284 return undef
285 if !defined $result
286 or $result == -1
287 && join("",$ss,$mm,$hh,$day,$month,$year)
288 ne join("",(localtime(-1))[0..5]);
289 }
290
291 return $result + $frac;
292}
293
2941;
295
296__END__