Re: [PATCH] Y2K Problem with HTTP::Date (libwww-5.42) (fwd)

Henri Periat (periat@ens.ascom.ch)
Thu, 29 Apr 1999 14:06:23 +0200


Hallo Reinhard

Besten Dank f=FCr Dein Mail.
But the following module has still some bugs.

> ---------- Forwarded message ----------
> Date: 23 Apr 1999 15:23:45 +0200
> From: Gisle Aas <gisle@aas.no>
> To: "W. Phillip Moore" <wpm@ms.com>
> Cc: libwww-perl@ics.uci.edu
> Subject: Re: [PATCH] Y2K Problem with HTTP::Date (libwww-5.42)
>=20
> "W. Phillip Moore" <wpm@ms.com> writes:
>=20
> > In the case of libwww-5.42, the test suites blow up when run in the
> > year 2000.
>=20
> Thank you for actually testing this and your patch.  Your bug report
> actually made me start rewriting HTTP::Date.  I wanted to also be able
> to avoid 2038 problems.  The str2time() will still not return dates
> after 2038 as it is now, but the new str2date() should not have such
> problems.
>=20
> Regards,
> Gisle
>=20
>=20
> #--------------------------------------------
> package HTTP::Date;  # $Date: 1999/04/23 13:07:11 $
>=20
> $VERSION =3D sprintf("%d.%02d", q$Revision: 1.30 $ =3D~ =
/(\d+)\.(\d+)/);
>=20
> require 5.002;
> require Exporter;
> @ISA =3D qw(Exporter);
> @EXPORT =3D qw(time2str str2time);
> @EXPORT_OK =3D qw(time2iso time2isoz);
>=20
> use strict;
> use Time::Local ();
>=20
> use vars qw(@DoW @MoY %MoY);
> @DoW =3D qw(Sun Mon Tue Wed Thu Fri Sat);
> @MoY =3D qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
> @MoY{map lc, @MoY} =3D (1..12);
>=20
> my %zulu_zone =3D (gmt =3D> 0, utc =3D> 0, ut =3D> 0, z =3D> 0);
>=20
>=20
> sub time2str (;$)
> {
>     my $time =3D shift;
>     $time =3D time unless defined $time;
>     my ($sec, $min, $hour, $mday, $mon, $year, $wday) =3D =
gmtime($time);
>     sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
> 	    $DoW[$wday],
> 	    $mday, $MoY[$mon], $year+1900,
> 	    $hour, $min, $sec);
> }
>=20
>=20
> sub str2time ($;$)
> {
>     my @d =3D &str2date;
>     return unless @d;
>     $d[0] -=3D 1900;  # year
>     $d[1]--;        # month
>=20
>     # timelocal() seems to go into an infinite loop if it is given out
>     # of range parameters.  Let's check the year at least.
>     # Epoch counter maxes out in year 2038, assuming "time_t" is 32 =
bit
>     return if $d[0] > 138;
>     return if $d[0] <  70;  # 1970 is Unix epoch
>=20
>     my $mktime_func =3D pop(@d) ? \&Time::Local::timegm
> 	                      : \&Time::Local::timelocal;
>     eval { &$mktime_func(reverse @d) };
> }
>=20
>=20
> sub str2date ($;$)
> {
>     local($_) =3D shift;
>     return unless defined;
>     my $default_zone =3D shift;
>=20
>     s/^\s+//;  # kill leading space
>     s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)\w*,?\s*//i; # Useless weekday
>=20
>     my($day, $mon, $yr, $hr, $min, $sec, $tz, $aorp);
>=20
>   PARSEDATE: {
>       # Then we are able to check for most of the formats with this =
regexp
>       ($day,$mon,$yr,$hr,$min,$sec,$tz) =3D
> 	/^
> 	 (\d\d?)               # day
> 	    (?:\s+|[-\/])
> 	 (\w+)                 # month
> 	    (?:\s+|[-\/])
> 	 (\d+)                 # year
> 	 (?:
> 	       (?:\s+|:)       # separator before clock
> 	    (\d\d?):(\d\d)     # hour:min
> 	    (?::(\d\d))?       # optional seconds
> 	 )?                    # optional clock
> 	    \s*
> 	 ([-+]?\d{2,4}|GMT|gmt)? # timezone
> 	    \s*$
> 	/x
> 	  and last PARSEDATE;
>=20
>       # Try the ctime and asctime format
>       ($mon, $day, $hr, $min, $sec, $tz, $yr) =3D
> 	/^
> 	 (\w{1,3})             # month
> 	    \s+
> 	 (\d\d?)               # day
> 	    \s+
> 	 (\d\d?):(\d\d)        # hour:min
> 	 (?::(\d\d))?          # optional seconds
> 	    \s+
> 	 (?:(GMT|gmt)\s+)?     # optional GMT timezone
> 	 (\d+)                 # year
> 	    \s*$               # allow trailing whitespace
> 	/x
> 	  and last PARSEDATE;
>=20
>       # Then the Unix 'ls -l' date format
>       ($mon, $day, $yr, $hr, $min, $sec) =3D
> 	/^
> 	 (\w{3})               # month
> 	    \s+
> 	 (\d\d?)               # day
> 	    \s+
> 	 (?:
> 	    (\d\d\d\d) |       # year
> 	    (\d{1,2}):(\d{2})  # hour:min
>             (?::(\d\d))?       # optional seconds
> 	 )
> 	 \s*$
>        /x
> 	 and last PARSEDATE;
>=20
>       # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants
>       ($yr, $mon, $day, $hr, $min, $sec, $tz) =3D
> 	/^
> 	  (\d{4})              # year
> 	     [-\/]?
> 	  (\d\d?)              # numerical month
> 	     [-\/]?
> 	  (\d\d?)              # day
> 	 (?:
> 	       (?:\s+|:|T|-)   # separator before clock
> 	    (\d\d?):?(\d\d)    # hour:min
> 	    (?::?(\d\d))?      # optional seconds
> 	 )?                    # optional clock
> 	    \s*
> 	 ([-+]?\d\d?:?(:?\d\d)?
> 	  |Z|z)?               # timezone  (Z is "zero meridian", i.e. GMT)
> 	    \s*$
> 	/x
> 	  and last PARSEDATE;
>=20
>       # Windows 'dir' 11-12-96  03:52PM
>       ($mon, $day, $yr, $hr, $min, $aorp) =3D
>         /^
>           (\d{2})                # numerical month
>              -
>           (\d{2})                # day
>              -
>           (\d{2})                # year
>              \s+
>           (\d\d?):(\d\d)([apAP][mM])  # hour:min AM or PM
>              \s*$
>         /x
>           and last PARSEDATE;
>=20
>       # If it is not recognized by now we give up
>       return;
>     }
>=20
>     # Translate month name to number
>     if ($mon =3D~ /^\d+$/) {
> 	# numeric month
> 	return if $mon < 1 || $mon > 12;
>     } else {
> 	$mon =3D $MoY{lc $mon} || return;
>     }
>=20
>     # If the year is missing, we assume some date before the current,
>     # because of the formats we support such dates are mostly present
>     # on "ls -l" listings.
>     unless (defined $yr) {
> 	my($cur_mon, $yr) =3D (localtime)[4, 5];

$yr is local now to this block and after it, still undefined.

        my($cur_mon);
        ($cur_mon, $yr) =3D (localtime)[4, 5];
       =20
would solve that.
       =20
> 	$yr +=3D 1900;
> 	$yr-- if $mon > $cur_mon;

The numbers for months start in %MoY at 1, but with localtime() with 0.

      $yr--  if ($mon > ($cur_mon + 1))
     =20
could solve this problem.
       =20
>     }
>=20
>     # Then we check if the year is acceptable
>     if (length($yr) < 3) {
> 	# Find "obvious" year
> 	my $cur_yr =3D (localtime)[5] + 1900;
> 	my $m =3D $cur_yr % 100;
> 	my $tmp =3D $yr;
>=20
> 	$yr +=3D $cur_yr - $m;
> 	$m -=3D $tmp;
> 	$yr +=3D ($m > 0) ? 100 : -100
> 	    if abs($m) > 50;
>     }
>=20
>     # Make sure clock elements are defined
>     for ($sec, $min, $hr) {  $_ =3D 0 unless defined   }
>=20
>     # Compensate for AM/PM
>     if ($aorp) {
> 	$aorp =3D uc $aorp;
> 	$hr =3D 0 if $hr =3D=3D 12 && $aorp eq 'AM';
> 	$hr +=3D 12 if $aorp eq 'PM' && $hr !=3D 12;
>     }
>=20
>     my $gmt;
>     $tz =3D shift unless defined $tz;

Here nothing has left to shift.

      $tz =3D $default_zone  unless defined $tz;
     =20
Gives the right results.

>     if (defined $tz) {
> 	$gmt++;
>=20
> 	my $offset;
> 	if (exists $zulu_zone{lc $tz}) {
> 	    # ok
> 	    $offset =3D 0;
> 	} elsif ($tz =3D~ /^([-+])?(\d\d?):?(\d\d)?$/) {
> 	    $offset =3D 3600 * $2;
> 	    $offset +=3D 60 * $3 if $3;
> 	    $offset *=3D -1 if $1 && $1 ne '-';
> 	} else {
> 	    require Time::Zone;
> 	    die;
> 	    $offset =3D Time::Zone::tz_offset($tz);
> 	}
> 	if ($offset) {
> 	    return;  # XXX Not yet implemented

            my $t =3D Time::Local::timegm($sec, $min, $hr, $day, $mon-1, =
=20
$yr-1900);
            ($sec, $min, $hr, $day, $mon, $yr) =3D gmtime($t + $offset);
            $yr +=3D 1900;
            $mon++;
           =20
Ok i agree, this is not a very elegant solution, but it works.

> 	}
>     }
> =09
>     wantarray ? ($yr, $mon, $day, $hr, $min, $sec, $gmt)
> 	      : sprintf("%04d-%02d-%02d %02d:%02d:%02d%s",
> 			$yr, $mon, $day, $hr, $min, $sec, $gmt?"Z":"");
> }
>=20
> sub time2iso (;$)
> {
>     my $time =3D shift;
>     $time =3D time unless defined $time;
>     my($sec,$min,$hour,$mday,$mon,$year) =3D localtime($time);
>     sprintf("%04d-%02d-%02d %02d:%02d:%02d",
> 	    $year+1900, $mon+1, $mday, $hour, $min, $sec);
> }
>=20
> sub time2isoz (;$)
> {
>     my $time =3D shift;
>     $time =3D time unless defined $time;
>     my($sec,$min,$hour,$mday,$mon,$year) =3D gmtime($time);
>     sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
>             $year+1900, $mon+1, $mday, $hour, $min, $sec);
> }
>=20
> 1;


With this modifications Date.pm passed at least the tests of 'make test' =
for
libwww-perl-5.42


Regards
Henri