| 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 | |