| 1 | package HTTP::Date;
|
|---|
| 2 |
|
|---|
| 3 | $VERSION = "6.02";
|
|---|
| 4 |
|
|---|
| 5 | require Exporter;
|
|---|
| 6 | @ISA = qw(Exporter);
|
|---|
| 7 | @EXPORT = qw(time2str str2time);
|
|---|
| 8 | @EXPORT_OK = qw(parse_date time2iso time2isoz);
|
|---|
| 9 |
|
|---|
| 10 | use strict;
|
|---|
| 11 | require Time::Local;
|
|---|
| 12 |
|
|---|
| 13 | use vars qw(@DoW @MoY %MoY);
|
|---|
| 14 | @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
|
|---|
| 15 | @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
|
|---|
| 16 | @MoY{@MoY} = (1..12);
|
|---|
| 17 |
|
|---|
| 18 | my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1);
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 | sub time2str (;$)
|
|---|
| 22 | {
|
|---|
| 23 | my $time = shift;
|
|---|
| 24 | $time = time unless defined $time;
|
|---|
| 25 | my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
|
|---|
| 26 | sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
|
|---|
| 27 | $DoW[$wday],
|
|---|
| 28 | $mday, $MoY[$mon], $year+1900,
|
|---|
| 29 | $hour, $min, $sec);
|
|---|
| 30 | }
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 | sub str2time ($;$)
|
|---|
| 34 | {
|
|---|
| 35 | my $str = shift;
|
|---|
| 36 | return undef unless defined $str;
|
|---|
| 37 |
|
|---|
| 38 | # fast exit for strictly conforming string
|
|---|
| 39 | if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT$/) {
|
|---|
| 40 | return eval {
|
|---|
| 41 | my $t = Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3);
|
|---|
| 42 | $t < 0 ? undef : $t;
|
|---|
| 43 | };
|
|---|
| 44 | }
|
|---|
| 45 |
|
|---|
| 46 | my @d = parse_date($str);
|
|---|
| 47 | return undef unless @d;
|
|---|
| 48 | $d[1]--; # month
|
|---|
| 49 |
|
|---|
| 50 | my $tz = pop(@d);
|
|---|
| 51 | unless (defined $tz) {
|
|---|
| 52 | unless (defined($tz = shift)) {
|
|---|
| 53 | return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
|
|---|
| 54 | my $t = Time::Local::timelocal(reverse @d) + $frac;
|
|---|
| 55 | $t < 0 ? undef : $t;
|
|---|
| 56 | };
|
|---|
| 57 | }
|
|---|
| 58 | }
|
|---|
| 59 |
|
|---|
| 60 | my $offset = 0;
|
|---|
| 61 | if ($GMT_ZONE{uc $tz}) {
|
|---|
| 62 | # offset already zero
|
|---|
| 63 | }
|
|---|
| 64 | elsif ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
|
|---|
| 65 | $offset = 3600 * $2;
|
|---|
| 66 | $offset += 60 * $3 if $3;
|
|---|
| 67 | $offset *= -1 if $1 && $1 eq '-';
|
|---|
| 68 | }
|
|---|
| 69 | else {
|
|---|
| 70 | eval { require Time::Zone } || return undef;
|
|---|
| 71 | $offset = Time::Zone::tz_offset($tz);
|
|---|
| 72 | return undef unless defined $offset;
|
|---|
| 73 | }
|
|---|
| 74 |
|
|---|
| 75 | return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
|
|---|
| 76 | my $t = Time::Local::timegm(reverse @d) + $frac;
|
|---|
| 77 | $t < 0 ? undef : $t - $offset;
|
|---|
| 78 | };
|
|---|
| 79 | }
|
|---|
| 80 |
|
|---|
| 81 |
|
|---|
| 82 | sub parse_date ($)
|
|---|
| 83 | {
|
|---|
| 84 | local($_) = shift;
|
|---|
| 85 | return unless defined;
|
|---|
| 86 |
|
|---|
| 87 | # More lax parsing below
|
|---|
| 88 | s/^\s+//; # kill leading space
|
|---|
| 89 | s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday
|
|---|
| 90 |
|
|---|
| 91 | my($day, $mon, $yr, $hr, $min, $sec, $tz, $ampm);
|
|---|
| 92 |
|
|---|
| 93 | # Then we are able to check for most of the formats with this regexp
|
|---|
| 94 | (($day,$mon,$yr,$hr,$min,$sec,$tz) =
|
|---|
| 95 | /^
|
|---|
| 96 | (\d\d?) # day
|
|---|
| 97 | (?:\s+|[-\/])
|
|---|
| 98 | (\w+) # month
|
|---|
| 99 | (?:\s+|[-\/])
|
|---|
| 100 | (\d+) # year
|
|---|
| 101 | (?:
|
|---|
| 102 | (?:\s+|:) # separator before clock
|
|---|
| 103 | (\d\d?):(\d\d) # hour:min
|
|---|
| 104 | (?::(\d\d))? # optional seconds
|
|---|
| 105 | )? # optional clock
|
|---|
| 106 | \s*
|
|---|
| 107 | ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone
|
|---|
| 108 | \s*
|
|---|
| 109 | (?:\(\w+\)|\w{3,})? # ASCII representation of timezone.
|
|---|
| 110 | \s*$
|
|---|
| 111 | /x)
|
|---|
| 112 |
|
|---|
| 113 | ||
|
|---|
| 114 |
|
|---|
| 115 | # Try the ctime and asctime format
|
|---|
| 116 | (($mon, $day, $hr, $min, $sec, $tz, $yr) =
|
|---|
| 117 | /^
|
|---|
| 118 | (\w{1,3}) # month
|
|---|
| 119 | \s+
|
|---|
| 120 | (\d\d?) # day
|
|---|
| 121 | \s+
|
|---|
| 122 | (\d\d?):(\d\d) # hour:min
|
|---|
| 123 | (?::(\d\d))? # optional seconds
|
|---|
| 124 | \s+
|
|---|
| 125 | (?:([A-Za-z]+)\s+)? # optional timezone
|
|---|
| 126 | (\d+) # year
|
|---|
| 127 | \s*$ # allow trailing whitespace
|
|---|
| 128 | /x)
|
|---|
| 129 |
|
|---|
| 130 | ||
|
|---|
| 131 |
|
|---|
| 132 | # Then the Unix 'ls -l' date format
|
|---|
| 133 | (($mon, $day, $yr, $hr, $min, $sec) =
|
|---|
| 134 | /^
|
|---|
| 135 | (\w{3}) # month
|
|---|
| 136 | \s+
|
|---|
| 137 | (\d\d?) # day
|
|---|
| 138 | \s+
|
|---|
| 139 | (?:
|
|---|
| 140 | (\d\d\d\d) | # year
|
|---|
| 141 | (\d{1,2}):(\d{2}) # hour:min
|
|---|
| 142 | (?::(\d\d))? # optional seconds
|
|---|
| 143 | )
|
|---|
| 144 | \s*$
|
|---|
| 145 | /x)
|
|---|
| 146 |
|
|---|
| 147 | ||
|
|---|
| 148 |
|
|---|
| 149 | # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants
|
|---|
| 150 | (($yr, $mon, $day, $hr, $min, $sec, $tz) =
|
|---|
| 151 | /^
|
|---|
| 152 | (\d{4}) # year
|
|---|
| 153 | [-\/]?
|
|---|
| 154 | (\d\d?) # numerical month
|
|---|
| 155 | [-\/]?
|
|---|
| 156 | (\d\d?) # day
|
|---|
| 157 | (?:
|
|---|
| 158 | (?:\s+|[-:Tt]) # separator before clock
|
|---|
| 159 | (\d\d?):?(\d\d) # hour:min
|
|---|
| 160 | (?::?(\d\d(?:\.\d*)?))? # optional seconds (and fractional)
|
|---|
| 161 | )? # optional clock
|
|---|
| 162 | \s*
|
|---|
| 163 | ([-+]?\d\d?:?(:?\d\d)?
|
|---|
| 164 | |Z|z)? # timezone (Z is "zero meridian", i.e. GMT)
|
|---|
| 165 | \s*$
|
|---|
| 166 | /x)
|
|---|
| 167 |
|
|---|
| 168 | ||
|
|---|
| 169 |
|
|---|
| 170 | # Windows 'dir' 11-12-96 03:52PM
|
|---|
| 171 | (($mon, $day, $yr, $hr, $min, $ampm) =
|
|---|
| 172 | /^
|
|---|
| 173 | (\d{2}) # numerical month
|
|---|
| 174 | -
|
|---|
| 175 | (\d{2}) # day
|
|---|
| 176 | -
|
|---|
| 177 | (\d{2}) # year
|
|---|
| 178 | \s+
|
|---|
| 179 | (\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM
|
|---|
| 180 | \s*$
|
|---|
| 181 | /x)
|
|---|
| 182 |
|
|---|
| 183 | ||
|
|---|
| 184 | return; # unrecognized format
|
|---|
| 185 |
|
|---|
| 186 | # Translate month name to number
|
|---|
| 187 | $mon = $MoY{$mon} ||
|
|---|
| 188 | $MoY{"\u\L$mon"} ||
|
|---|
| 189 | ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon <= 12 && int($mon)) ||
|
|---|
| 190 | return;
|
|---|
| 191 |
|
|---|
| 192 | # If the year is missing, we assume first date before the current,
|
|---|
| 193 | # because of the formats we support such dates are mostly present
|
|---|
| 194 | # on "ls -l" listings.
|
|---|
| 195 | unless (defined $yr) {
|
|---|
| 196 | my $cur_mon;
|
|---|
| 197 | ($cur_mon, $yr) = (localtime)[4, 5];
|
|---|
| 198 | $yr += 1900;
|
|---|
| 199 | $cur_mon++;
|
|---|
| 200 | $yr-- if $mon > $cur_mon;
|
|---|
| 201 | }
|
|---|
| 202 | elsif (length($yr) < 3) {
|
|---|
| 203 | # Find "obvious" year
|
|---|
| 204 | my $cur_yr = (localtime)[5] + 1900;
|
|---|
| 205 | my $m = $cur_yr % 100;
|
|---|
| 206 | my $tmp = $yr;
|
|---|
| 207 | $yr += $cur_yr - $m;
|
|---|
| 208 | $m -= $tmp;
|
|---|
| 209 | $yr += ($m > 0) ? 100 : -100
|
|---|
| 210 | if abs($m) > 50;
|
|---|
| 211 | }
|
|---|
| 212 |
|
|---|
| 213 | # Make sure clock elements are defined
|
|---|
| 214 | $hr = 0 unless defined($hr);
|
|---|
| 215 | $min = 0 unless defined($min);
|
|---|
| 216 | $sec = 0 unless defined($sec);
|
|---|
| 217 |
|
|---|
| 218 | # Compensate for AM/PM
|
|---|
| 219 | if ($ampm) {
|
|---|
| 220 | $ampm = uc $ampm;
|
|---|
| 221 | $hr = 0 if $hr == 12 && $ampm eq 'AM';
|
|---|
| 222 | $hr += 12 if $ampm eq 'PM' && $hr != 12;
|
|---|
| 223 | }
|
|---|
| 224 |
|
|---|
| 225 | return($yr, $mon, $day, $hr, $min, $sec, $tz)
|
|---|
| 226 | if wantarray;
|
|---|
| 227 |
|
|---|
| 228 | if (defined $tz) {
|
|---|
| 229 | $tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/;
|
|---|
| 230 | }
|
|---|
| 231 | else {
|
|---|
| 232 | $tz = "";
|
|---|
| 233 | }
|
|---|
| 234 | return sprintf("%04d-%02d-%02d %02d:%02d:%02d%s",
|
|---|
| 235 | $yr, $mon, $day, $hr, $min, $sec, $tz);
|
|---|
| 236 | }
|
|---|
| 237 |
|
|---|
| 238 |
|
|---|
| 239 | sub time2iso (;$)
|
|---|
| 240 | {
|
|---|
| 241 | my $time = shift;
|
|---|
| 242 | $time = time unless defined $time;
|
|---|
| 243 | my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
|---|
| 244 | sprintf("%04d-%02d-%02d %02d:%02d:%02d",
|
|---|
| 245 | $year+1900, $mon+1, $mday, $hour, $min, $sec);
|
|---|
| 246 | }
|
|---|
| 247 |
|
|---|
| 248 |
|
|---|
| 249 | sub time2isoz (;$)
|
|---|
| 250 | {
|
|---|
| 251 | my $time = shift;
|
|---|
| 252 | $time = time unless defined $time;
|
|---|
| 253 | my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
|
|---|
| 254 | sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
|
|---|
| 255 | $year+1900, $mon+1, $mday, $hour, $min, $sec);
|
|---|
| 256 | }
|
|---|
| 257 |
|
|---|
| 258 | 1;
|
|---|
| 259 |
|
|---|
| 260 |
|
|---|
| 261 | __END__
|
|---|
| 262 |
|
|---|
| 263 | =head1 NAME
|
|---|
| 264 |
|
|---|
| 265 | HTTP::Date - date conversion routines
|
|---|
| 266 |
|
|---|
| 267 | =head1 SYNOPSIS
|
|---|
| 268 |
|
|---|
| 269 | use HTTP::Date;
|
|---|
| 270 |
|
|---|
| 271 | $string = time2str($time); # Format as GMT ASCII time
|
|---|
| 272 | $time = str2time($string); # convert ASCII date to machine time
|
|---|
| 273 |
|
|---|
| 274 | =head1 DESCRIPTION
|
|---|
| 275 |
|
|---|
| 276 | This module provides functions that deal the date formats used by the
|
|---|
| 277 | HTTP protocol (and then some more). Only the first two functions,
|
|---|
| 278 | time2str() and str2time(), are exported by default.
|
|---|
| 279 |
|
|---|
| 280 | =over 4
|
|---|
| 281 |
|
|---|
| 282 | =item time2str( [$time] )
|
|---|
| 283 |
|
|---|
| 284 | The time2str() function converts a machine time (seconds since epoch)
|
|---|
| 285 | to a string. If the function is called without an argument or with an
|
|---|
| 286 | undefined argument, it will use the current time.
|
|---|
| 287 |
|
|---|
| 288 | The string returned is in the format preferred for the HTTP protocol.
|
|---|
| 289 | This is a fixed length subset of the format defined by RFC 1123,
|
|---|
| 290 | represented in Universal Time (GMT). An example of a time stamp
|
|---|
| 291 | in this format is:
|
|---|
| 292 |
|
|---|
| 293 | Sun, 06 Nov 1994 08:49:37 GMT
|
|---|
| 294 |
|
|---|
| 295 | =item str2time( $str [, $zone] )
|
|---|
| 296 |
|
|---|
| 297 | The str2time() function converts a string to machine time. It returns
|
|---|
| 298 | C<undef> if the format of $str is unrecognized, otherwise whatever the
|
|---|
| 299 | C<Time::Local> functions can make out of the parsed time. Dates
|
|---|
| 300 | before the system's epoch may not work on all operating systems. The
|
|---|
| 301 | time formats recognized are the same as for parse_date().
|
|---|
| 302 |
|
|---|
| 303 | The function also takes an optional second argument that specifies the
|
|---|
| 304 | default time zone to use when converting the date. This parameter is
|
|---|
| 305 | ignored if the zone is found in the date string itself. If this
|
|---|
| 306 | parameter is missing, and the date string format does not contain any
|
|---|
| 307 | zone specification, then the local time zone is assumed.
|
|---|
| 308 |
|
|---|
| 309 | If the zone is not "C<GMT>" or numerical (like "C<-0800>" or
|
|---|
| 310 | "C<+0100>"), then the C<Time::Zone> module must be installed in order
|
|---|
| 311 | to get the date recognized.
|
|---|
| 312 |
|
|---|
| 313 | =item parse_date( $str )
|
|---|
| 314 |
|
|---|
| 315 | This function will try to parse a date string, and then return it as a
|
|---|
| 316 | list of numerical values followed by a (possible undefined) time zone
|
|---|
| 317 | specifier; ($year, $month, $day, $hour, $min, $sec, $tz). The $year
|
|---|
| 318 | will be the full 4-digit year, and $month numbers start with 1 (for January).
|
|---|
| 319 |
|
|---|
| 320 | In scalar context the numbers are interpolated in a string of the
|
|---|
| 321 | "YYYY-MM-DD hh:mm:ss TZ"-format and returned.
|
|---|
| 322 |
|
|---|
| 323 | If the date is unrecognized, then the empty list is returned (C<undef> in
|
|---|
| 324 | scalar context).
|
|---|
| 325 |
|
|---|
| 326 | The function is able to parse the following formats:
|
|---|
| 327 |
|
|---|
| 328 | "Wed, 09 Feb 1994 22:23:32 GMT" -- HTTP format
|
|---|
| 329 | "Thu Feb 3 17:03:55 GMT 1994" -- ctime(3) format
|
|---|
| 330 | "Thu Feb 3 00:00:00 1994", -- ANSI C asctime() format
|
|---|
| 331 | "Tuesday, 08-Feb-94 14:15:29 GMT" -- old rfc850 HTTP format
|
|---|
| 332 | "Tuesday, 08-Feb-1994 14:15:29 GMT" -- broken rfc850 HTTP format
|
|---|
| 333 |
|
|---|
| 334 | "03/Feb/1994:17:03:55 -0700" -- common logfile format
|
|---|
| 335 | "09 Feb 1994 22:23:32 GMT" -- HTTP format (no weekday)
|
|---|
| 336 | "08-Feb-94 14:15:29 GMT" -- rfc850 format (no weekday)
|
|---|
| 337 | "08-Feb-1994 14:15:29 GMT" -- broken rfc850 format (no weekday)
|
|---|
| 338 |
|
|---|
| 339 | "1994-02-03 14:15:29 -0100" -- ISO 8601 format
|
|---|
| 340 | "1994-02-03 14:15:29" -- zone is optional
|
|---|
| 341 | "1994-02-03" -- only date
|
|---|
| 342 | "1994-02-03T14:15:29" -- Use T as separator
|
|---|
| 343 | "19940203T141529Z" -- ISO 8601 compact format
|
|---|
| 344 | "19940203" -- only date
|
|---|
| 345 |
|
|---|
| 346 | "08-Feb-94" -- old rfc850 HTTP format (no weekday, no time)
|
|---|
| 347 | "08-Feb-1994" -- broken rfc850 HTTP format (no weekday, no time)
|
|---|
| 348 | "09 Feb 1994" -- proposed new HTTP format (no weekday, no time)
|
|---|
| 349 | "03/Feb/1994" -- common logfile format (no time, no offset)
|
|---|
| 350 |
|
|---|
| 351 | "Feb 3 1994" -- Unix 'ls -l' format
|
|---|
| 352 | "Feb 3 17:03" -- Unix 'ls -l' format
|
|---|
| 353 |
|
|---|
| 354 | "11-15-96 03:52PM" -- Windows 'dir' format
|
|---|
| 355 |
|
|---|
| 356 | The parser ignores leading and trailing whitespace. It also allow the
|
|---|
| 357 | seconds to be missing and the month to be numerical in most formats.
|
|---|
| 358 |
|
|---|
| 359 | If the year is missing, then we assume that the date is the first
|
|---|
| 360 | matching date I<before> current month. If the year is given with only
|
|---|
| 361 | 2 digits, then parse_date() will select the century that makes the
|
|---|
| 362 | year closest to the current date.
|
|---|
| 363 |
|
|---|
| 364 | =item time2iso( [$time] )
|
|---|
| 365 |
|
|---|
| 366 | Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ss"-formatted
|
|---|
| 367 | string representing time in the local time zone.
|
|---|
| 368 |
|
|---|
| 369 | =item time2isoz( [$time] )
|
|---|
| 370 |
|
|---|
| 371 | Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ssZ"-formatted
|
|---|
| 372 | string representing Universal Time.
|
|---|
| 373 |
|
|---|
| 374 |
|
|---|
| 375 | =back
|
|---|
| 376 |
|
|---|
| 377 | =head1 SEE ALSO
|
|---|
| 378 |
|
|---|
| 379 | L<perlfunc/time>, L<Time::Zone>
|
|---|
| 380 |
|
|---|
| 381 | =head1 COPYRIGHT
|
|---|
| 382 |
|
|---|
| 383 | Copyright 1995-1999, Gisle Aas
|
|---|
| 384 |
|
|---|
| 385 | This library is free software; you can redistribute it and/or
|
|---|
| 386 | modify it under the same terms as Perl itself.
|
|---|
| 387 |
|
|---|
| 388 | =cut
|
|---|
