git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-perl/libwww-perl-5.813/debian/libwww-perl/usr/share/perl5/HTTP/Date.pm

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