Filename | /usr/local/lib/perl5/site_perl/Date/Parse.pm |
Statements | Executed 0 statements in 0s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN@10 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@11 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@12 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@13 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@210 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@8 | Date::Parse::
0 | 0 | 0 | 0s | 0s | BEGIN@9 | Date::Parse::
0 | 0 | 0 | 0s | 0s | CORE:sort (opcode) | Date::Parse::
0 | 0 | 0 | 0s | 0s | __ANON__[:269] | Date::Parse::
0 | 0 | 0 | 0s | 0s | __ANON__[:281] | Date::Parse::
0 | 0 | 0 | 0s | 0s | gen_parser | Date::Parse::
0 | 0 | 0 | 0s | 0s | str2time | Date::Parse::
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 | require 5.000; | ||||
8 | use strict; | ||||
9 | use vars qw($VERSION @ISA @EXPORT); | ||||
10 | use Time::Local; | ||||
11 | use Carp; | ||||
12 | use Time::Zone; | ||||
13 | use Exporter; | ||||
14 | |||||
15 | @ISA = qw(Exporter); | ||||
16 | @EXPORT = qw(&strtotime &str2time &strptime); | ||||
17 | |||||
18 | $VERSION = "2.33"; | ||||
19 | |||||
20 | 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 | 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 | my @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 | |||||
55 | map { $month{substr($_,0,3)} = $month{$_} } keys %month; | ||||
56 | map { $day{substr($_,0,3)} = $day{$_} } keys %day; | ||||
57 | |||||
58 | 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($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 | } | ||||
208 | ESQ | ||||
209 | |||||
210 | use vars qw($day_ref $mon_ref $suf_ref $obj); | ||||
211 | |||||
212 | sub 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 | ||||
221 | ESQ | ||||
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 | |||||
232 | sub 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 | |||||
294 | 1; | ||||
295 | |||||
296 | __END__ |