Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Date::Parse $Id: //depot/TimeDate/lib/Date/Parse.pm#14 $ |
2 | # | |
3 | # Copyright (c) 1995 Graham Barr. All rights reserved. This program is free | |
4 | # software; you can redistribute it and/or modify it under the same terms | |
5 | # as Perl itself. | |
6 | ||
7 | package Date::Parse; | |
8 | ||
9 | require 5.000; | |
10 | use strict; | |
11 | use vars qw($VERSION @ISA @EXPORT); | |
12 | use Time::Local; | |
13 | use Carp; | |
14 | use Time::Zone; | |
15 | use Exporter; | |
16 | ||
17 | @ISA = qw(Exporter); | |
18 | @EXPORT = qw(&strtotime &str2time &strptime); | |
19 | ||
20 | $VERSION = "2.23"; | |
21 | ||
22 | my %month = ( | |
23 | january => 0, | |
24 | february => 1, | |
25 | march => 2, | |
26 | april => 3, | |
27 | may => 4, | |
28 | june => 5, | |
29 | july => 6, | |
30 | august => 7, | |
31 | september => 8, | |
32 | sept => 8, | |
33 | october => 9, | |
34 | november => 10, | |
35 | december => 11, | |
36 | ); | |
37 | ||
38 | my %day = ( | |
39 | sunday => 0, | |
40 | monday => 1, | |
41 | tuesday => 2, | |
42 | tues => 2, | |
43 | wednesday => 3, | |
44 | wednes => 3, | |
45 | thursday => 4, | |
46 | thur => 4, | |
47 | thurs => 4, | |
48 | friday => 5, | |
49 | saturday => 6, | |
50 | ); | |
51 | ||
52 | my @suf = (qw(th st nd rd th th th th th th)) x 3; | |
53 | @suf[11,12,13] = qw(th th th); | |
54 | ||
55 | #Abbreviations | |
56 | ||
57 | map { $month{substr($_,0,3)} = $month{$_} } keys %month; | |
58 | map { $day{substr($_,0,3)} = $day{$_} } keys %day; | |
59 | ||
60 | my $strptime = <<'ESQ'; | |
61 | my %month = map { lc $_ } %$mon_ref; | |
62 | my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref); | |
63 | my $monpat = join("|", reverse sort keys %month); | |
64 | my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref); | |
65 | ||
66 | my %ampm = ( | |
67 | 'a' => 0, # AM | |
68 | 'p' => 12, # PM | |
69 | ); | |
70 | ||
71 | my($AM, $PM) = (0,12); | |
72 | ||
73 | sub { | |
74 | ||
75 | my $dtstr = lc shift; | |
76 | my $merid = 24; | |
77 | ||
78 | my($year,$month,$day,$hh,$mm,$ss,$zone,$dst); | |
79 | ||
80 | $zone = tz_offset(shift) if @_; | |
81 | ||
82 | 1 while $dtstr =~ s#\([^\(\)]*\)# #o; | |
83 | ||
84 | $dtstr =~ s#(\A|\n|\Z)# #sog; | |
85 | ||
86 | # ignore day names | |
87 | $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog; | |
88 | $dtstr =~ s#($daypat)\s*(den\s)?# #o; | |
89 | # Time: 12:00 or 12:00:00 with optional am/pm | |
90 | ||
91 | if ($dtstr =~ s/(?:^|\s)(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,]\d+)?)?)?)?\b/ /) { | |
92 | ($year,$month,$day,$hh,$mm,$ss) = ($1,$3-1,$4,$5,$7,$8); | |
93 | } | |
94 | else { | |
95 | ||
96 | if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?\s*(?:([ap])\.?m?\.?)?\s# #o) { | |
97 | ($hh,$mm,$ss) = ($1,$2,$4 || 0); | |
98 | $merid = $ampm{$5} if $5; | |
99 | } | |
100 | ||
101 | # Time: 12 am | |
102 | ||
103 | elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) { | |
104 | ($hh,$mm,$ss) = ($1,0,0); | |
105 | $merid = $ampm{$2}; | |
106 | } | |
107 | ||
108 | # Date: 12-June-96 (using - . or /) | |
109 | ||
110 | if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) { | |
111 | ($month,$day) = ($month{$3},$1); | |
112 | $year = $5 if $5; | |
113 | } | |
114 | ||
115 | # Date: 12-12-96 (using '-', '.' or '/' ) | |
116 | ||
117 | elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) { | |
118 | ($month,$day) = ($1 - 1,$3); | |
119 | ||
120 | if ($5) { | |
121 | $year = $5; | |
122 | # Possible match for 1995-01-24 (short mainframe date format); | |
123 | ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12; | |
124 | return if length($year) > 2 and $year < 1901; | |
125 | } | |
126 | } | |
127 | elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) { | |
128 | ($month,$day) = ($month{$3},$1); | |
129 | } | |
130 | elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) { | |
131 | ($month,$day) = ($month{$1},$2); | |
132 | } | |
133 | ||
134 | # Date: 961212 | |
135 | ||
136 | elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) { | |
137 | ($year,$month,$day) = ($1,$2-1,$3); | |
138 | } | |
139 | ||
140 | $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o; | |
141 | ||
142 | } | |
143 | ||
144 | # Zone | |
145 | ||
146 | $dst = 1 if $dtstr =~ s#\bdst\b##o; | |
147 | ||
148 | if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) { | |
149 | $dst = 1 if $2 and $2 eq 'dst'; | |
150 | $zone = tz_offset($1); | |
151 | return unless defined $zone; | |
152 | } | |
153 | elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) { | |
154 | my $m = defined($4) ? "$2$4" : 0; | |
155 | my $h = "$2$3"; | |
156 | $zone = defined($1) ? tz_offset($1) : 0; | |
157 | return unless defined $zone; | |
158 | $zone += 60 * ($m + (60 * $h)); | |
159 | } | |
160 | ||
161 | if ($dtstr =~ /\S/) { | |
162 | # now for some dumb dates | |
163 | if ($dtstr =~ s/^\s*(ut?|z)\s*$//) { | |
164 | $zone = 0; | |
165 | } | |
166 | elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) { | |
167 | my $m = defined($4) ? "$2$4" : 0; | |
168 | my $h = "$2$3"; | |
169 | $zone = defined($1) ? tz_offset($1) : 0; | |
170 | return unless defined $zone; | |
171 | $zone += 60 * ($m + (60 * $h)); | |
172 | } | |
173 | ||
174 | return if $dtstr =~ /\S/o; | |
175 | } | |
176 | ||
177 | if (defined $hh) { | |
178 | if ($hh == 12) { | |
179 | $hh = 0 if $merid == $AM; | |
180 | } | |
181 | elsif ($merid == $PM) { | |
182 | $hh += 12; | |
183 | } | |
184 | } | |
185 | ||
186 | $year -= 1900 if defined $year && $year > 1900; | |
187 | ||
188 | $zone += 3600 if defined $zone && $dst; | |
189 | ||
190 | return ($ss,$mm,$hh,$day,$month,$year,$zone); | |
191 | } | |
192 | ESQ | |
193 | ||
194 | use vars qw($day_ref $mon_ref $suf_ref $obj); | |
195 | ||
196 | sub gen_parser | |
197 | { | |
198 | local($day_ref,$mon_ref,$suf_ref,$obj) = @_; | |
199 | ||
200 | if($obj) | |
201 | { | |
202 | my $obj_strptime = $strptime; | |
203 | substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ'; | |
204 | shift; # package | |
205 | ESQ | |
206 | my $sub = eval "$obj_strptime" or die $@; | |
207 | return $sub; | |
208 | } | |
209 | ||
210 | eval "$strptime" or die $@; | |
211 | ||
212 | } | |
213 | ||
214 | *strptime = gen_parser(\%day,\%month,\@suf); | |
215 | ||
216 | sub str2time | |
217 | { | |
218 | my @t = strptime(@_); | |
219 | ||
220 | return undef | |
221 | unless @t; | |
222 | ||
223 | my($ss,$mm,$hh,$day,$month,$year,$zone) = @t; | |
224 | my @lt = localtime(time); | |
225 | ||
226 | $hh ||= 0; | |
227 | $mm ||= 0; | |
228 | $ss ||= 0; | |
229 | ||
230 | $month = $lt[4] | |
231 | unless(defined $month); | |
232 | ||
233 | $day = $lt[3] | |
234 | unless(defined $day); | |
235 | ||
236 | $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5] | |
237 | unless(defined $year); | |
238 | ||
239 | return undef | |
240 | unless($month <= 11 && $day >= 1 && $day <= 31 | |
241 | && $hh <= 23 && $mm <= 59 && $ss <= 59); | |
242 | ||
243 | my $result; | |
244 | ||
245 | if (defined $zone) { | |
246 | $result = eval { | |
247 | local $SIG{__DIE__} = sub {}; # Ick! | |
248 | timegm($ss,$mm,$hh,$day,$month,$year); | |
249 | }; | |
250 | return undef | |
251 | if !defined $result | |
252 | or $result == -1 | |
253 | && join("",$ss,$mm,$hh,$day,$month,$year) | |
254 | ne "595923311169"; | |
255 | $result -= $zone; | |
256 | } | |
257 | else { | |
258 | $result = eval { | |
259 | local $SIG{__DIE__} = sub {}; # Ick! | |
260 | timelocal($ss,$mm,$hh,$day,$month,$year); | |
261 | }; | |
262 | return undef | |
263 | if !defined $result | |
264 | or $result == -1 | |
265 | && join("",$ss,$mm,$hh,$day,$month,$year) | |
266 | ne join("",(localtime(-1))[0..5]); | |
267 | } | |
268 | ||
269 | return $result; | |
270 | } | |
271 | ||
272 | 1; | |
273 | ||
274 | __END__ | |
275 | ||
276 | ||
277 | =head1 NAME | |
278 | ||
279 | Date::Parse - Parse date strings into time values | |
280 | ||
281 | =head1 SYNOPSIS | |
282 | ||
283 | use Date::Parse; | |
284 | ||
285 | $time = str2time($date); | |
286 | ||
287 | ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date); | |
288 | ||
289 | =head1 DESCRIPTION | |
290 | ||
291 | C<Date::Parse> provides two routines for parsing date strings into time values. | |
292 | ||
293 | =over 4 | |
294 | ||
295 | =item str2time(DATE [, ZONE]) | |
296 | ||
297 | C<str2time> parses C<DATE> and returns a unix time value, or undef upon failure. | |
298 | C<ZONE>, if given, specifies the timezone to assume when parsing if the | |
299 | date string does not specify a timezome. | |
300 | ||
301 | =item strptime(DATE [, ZONE]) | |
302 | ||
303 | C<strptime> takes the same arguments as str2time but returns an array of | |
304 | values C<($ss,$mm,$hh,$day,$month,$year,$zone)>. Elements are only defined | |
305 | if they could be extracted from the date string. The C<$zone> element is | |
306 | the timezone offset in seconds from GMT. An empty array is returned upon | |
307 | failure. | |
308 | ||
309 | =head1 MULTI-LANGUAGE SUPPORT | |
310 | ||
311 | Date::Parse is capable of parsing dates in several languages, these are | |
312 | English, French, German and Italian. Changing the language is done via | |
313 | a static method call, for example | |
314 | ||
315 | Date::Parse->language('German'); | |
316 | ||
317 | will cause Date::Parse to attempt to parse any subsequent dates in German. | |
318 | ||
319 | This is only a first pass, I am considering changing this to be | |
320 | ||
321 | $lang = Date::Language->new('German'); | |
322 | $lang->str2time("25 Jun 1996 21:09:55 +0100"); | |
323 | ||
324 | I am open to suggestions on this. | |
325 | ||
326 | =head1 EXAMPLE DATES | |
327 | ||
328 | Below is a sample list of dates that are known to be parsable with Date::Parse | |
329 | ||
330 | 1995:01:24T09:08:17.1823213 ISO-8601 | |
331 | 1995-01-24T09:08:17.1823213 | |
332 | Wed, 16 Jun 94 07:29:35 CST Comma and day name are optional | |
333 | Thu, 13 Oct 94 10:13:13 -0700 | |
334 | Wed, 9 Nov 1994 09:50:32 -0500 (EST) Text in ()'s will be ignored. | |
335 | 21 dec 17:05 Will be parsed in the current time zone | |
336 | 21-dec 17:05 | |
337 | 21/dec 17:05 | |
338 | 21/dec/93 17:05 | |
339 | 1999 10:02:18 "GMT" | |
340 | 16 Nov 94 22:28:20 PST | |
341 | ||
342 | =head1 BUGS | |
343 | ||
344 | When both the month and the date are specified in the date as numbers | |
345 | they are always parsed assuming that the month number comes before the | |
346 | date. This is the usual format used in American dates. | |
347 | ||
348 | The reason why it is like this and not dynamic is that it must be | |
349 | deterministic. Several people have suggested using the current locale, | |
350 | but this will not work as the date being parsed may not be in the format | |
351 | of the current locale. | |
352 | ||
353 | My plans to address this, which will be in a future release, is to allow | |
354 | the programmer to state what order they want these values parsed in. | |
355 | ||
356 | =head1 AUTHOR | |
357 | ||
358 | Graham Barr <gbarr@pobox.com> | |
359 | ||
360 | =head1 COPYRIGHT | |
361 | ||
362 | Copyright (c) 1995 Graham Barr. All rights reserved. This program is free | |
363 | software; you can redistribute it and/or modify it under the same terms | |
364 | as Perl itself. | |
365 | ||
366 | =cut | |
367 | ||
368 | # $Id: //depot/TimeDate/lib/Date/Parse.pm#14 $ | |
369 |