[719] | 1 | use HTTP::Date;
|
---|
| 2 |
|
---|
| 3 | print "1..59\n";
|
---|
| 4 |
|
---|
| 5 | $no = 1;
|
---|
| 6 | $| = 1;
|
---|
| 7 | sub ok {
|
---|
| 8 | print "not " if $_[0];
|
---|
| 9 | print "ok $no\n";
|
---|
| 10 | $no++;
|
---|
| 11 | }
|
---|
| 12 |
|
---|
| 13 | # test str2time for supported dates
|
---|
| 14 | my(@tests) =
|
---|
| 15 | (
|
---|
| 16 | 'Thu Feb 3 00:00:00 GMT 1994', # ctime format
|
---|
| 17 | 'Thu Feb 3 00:00:00 1994', # same as ctime, except no TZ
|
---|
| 18 |
|
---|
| 19 | 'Thu, 03 Feb 1994 00:00:00 GMT', # proposed new HTTP format
|
---|
| 20 | 'Thursday, 03-Feb-94 00:00:00 GMT', # old rfc850 HTTP format
|
---|
| 21 | 'Thursday, 03-Feb-1994 00:00:00 GMT', # broken rfc850 HTTP format
|
---|
| 22 |
|
---|
| 23 | '03/Feb/1994:00:00:00 0000', # common logfile format
|
---|
| 24 | '03/Feb/1994:01:00:00 +0100', # common logfile format
|
---|
| 25 | '02/Feb/1994:23:00:00 -0100', # common logfile format
|
---|
| 26 |
|
---|
| 27 | '03 Feb 1994 00:00:00 GMT', # HTTP format (no weekday)
|
---|
| 28 | '03-Feb-94 00:00:00 GMT', # old rfc850 (no weekday)
|
---|
| 29 | '03-Feb-1994 00:00:00 GMT', # broken rfc850 (no weekday)
|
---|
| 30 | '03-Feb-1994 00:00 GMT', # broken rfc850 (no weekday, no seconds)
|
---|
| 31 | '03-Feb-1994 00:00', # VMS dir listing format
|
---|
| 32 |
|
---|
| 33 | '03-Feb-94', # old rfc850 HTTP format (no weekday, no time)
|
---|
| 34 | '03-Feb-1994', # broken rfc850 HTTP format (no weekday, no time)
|
---|
| 35 | '03 Feb 1994', # proposed new HTTP format (no weekday, no time)
|
---|
| 36 | '03/Feb/1994', # common logfile format (no time, no offset)
|
---|
| 37 |
|
---|
| 38 | #'Feb 3 00:00', # Unix 'ls -l' format (can't really test it here)
|
---|
| 39 | 'Feb 3 1994', # Unix 'ls -l' format
|
---|
| 40 |
|
---|
| 41 | "02-03-94 12:00AM", # Windows 'dir' format
|
---|
| 42 |
|
---|
| 43 | # ISO 8601 formats
|
---|
| 44 | '1994-02-03 00:00:00 +0000',
|
---|
| 45 | '1994-02-03',
|
---|
| 46 | '19940203',
|
---|
| 47 | '1994-02-03T00:00:00+0000',
|
---|
| 48 | '1994-02-02T23:00:00-0100',
|
---|
| 49 | '1994-02-02T23:00:00-01:00',
|
---|
| 50 | '1994-02-03T00:00:00 Z',
|
---|
| 51 | '19940203T000000Z',
|
---|
| 52 | '199402030000',
|
---|
| 53 |
|
---|
| 54 | # A few tests with extra space at various places
|
---|
| 55 | ' 03/Feb/1994 ',
|
---|
| 56 | ' 03 Feb 1994 0:00 ',
|
---|
| 57 | );
|
---|
| 58 |
|
---|
| 59 | my $time = 760233600; # assume broken POSIX counting of seconds
|
---|
| 60 | for (@tests) {
|
---|
| 61 | if (/GMT/i) {
|
---|
| 62 | $t = str2time($_);
|
---|
| 63 | } else {
|
---|
| 64 | $t = str2time($_, "GMT");
|
---|
| 65 | }
|
---|
| 66 | $t = "UNDEF" unless defined $t;
|
---|
| 67 | print "'$_' => $t\n";
|
---|
| 68 | print $@ if $@;
|
---|
| 69 | print "not " if $t eq 'UNDEF' || $t != $time;
|
---|
| 70 | ok;
|
---|
| 71 | }
|
---|
| 72 |
|
---|
| 73 | # test time2str
|
---|
| 74 | die "time2str failed"
|
---|
| 75 | unless time2str($time) eq 'Thu, 03 Feb 1994 00:00:00 GMT';
|
---|
| 76 |
|
---|
| 77 | # test the 'ls -l' format with missing year$
|
---|
| 78 | # round to nearest minute 3 days ago.
|
---|
| 79 | $time = int((time - 3 * 24*60*60) /60)*60;
|
---|
| 80 | ($min, $hr, $mday, $mon) = (localtime $time)[1,2,3,4];
|
---|
| 81 | $mon = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon];
|
---|
| 82 | $str = sprintf("$mon %02d %02d:%02d", $mday, $hr, $min);
|
---|
| 83 | $t = str2time($str);
|
---|
| 84 | $t = "UNDEF" unless defined $t;
|
---|
| 85 | print "'$str' => $t ($time)\n";
|
---|
| 86 | print "not " if $t != $time;
|
---|
| 87 | ok;
|
---|
| 88 |
|
---|
| 89 | # try some out of bounds date and some garbage.
|
---|
| 90 | for ('03-Feb-1969', '03-Feb-2039',
|
---|
| 91 | undef, '', 'Garbage',
|
---|
| 92 | 'Mandag 16. September 1996',
|
---|
| 93 | 'Thu Feb 3 00:00:00 CET 1994',
|
---|
| 94 | 'Thu, 03 Feb 1994 00:00:00 CET',
|
---|
| 95 | 'Wednesday, 31-Dec-69 23:59:59 GMT',
|
---|
| 96 |
|
---|
| 97 | '1980-00-01',
|
---|
| 98 | '1980-13-01',
|
---|
| 99 | '1980-01-00',
|
---|
| 100 | '1980-01-32',
|
---|
| 101 | '1980-01-01 25:00:00',
|
---|
| 102 | '1980-01-01 00:61:00',
|
---|
| 103 | '1980-01-01 00:00:61',
|
---|
| 104 | )
|
---|
| 105 | {
|
---|
| 106 | my $bad = 0;
|
---|
| 107 | eval {
|
---|
| 108 | if (defined str2time $_) {
|
---|
| 109 | print "str2time($_) is not undefined\n";
|
---|
| 110 | $bad++;
|
---|
| 111 | }
|
---|
| 112 | };
|
---|
| 113 | print defined($_) ? "'$_'\n" : "undef\n";
|
---|
| 114 | print $@ if $@;
|
---|
| 115 | print "not " if $bad;
|
---|
| 116 | ok;
|
---|
| 117 | }
|
---|
| 118 |
|
---|
| 119 | print "Testing AM/PM gruff...\n";
|
---|
| 120 |
|
---|
| 121 | $t = time2iso(str2time("11-12-96 0:00AM"));print "$t\n";
|
---|
| 122 | ok($t ne "1996-11-12 00:00:00");
|
---|
| 123 |
|
---|
| 124 | $t = time2iso(str2time("11-12-96 12:00AM"));print "$t\n";
|
---|
| 125 | ok($t ne "1996-11-12 00:00:00");
|
---|
| 126 |
|
---|
| 127 | $t = time2iso(str2time("11-12-96 0:00PM"));print "$t\n";
|
---|
| 128 | ok($t ne "1996-11-12 12:00:00");
|
---|
| 129 |
|
---|
| 130 | $t = time2iso(str2time("11-12-96 12:00PM"));print "$t\n";
|
---|
| 131 | ok($t ne "1996-11-12 12:00:00");
|
---|
| 132 |
|
---|
| 133 |
|
---|
| 134 | $t = time2iso(str2time("11-12-96 1:05AM"));print "$t\n";
|
---|
| 135 | ok($t ne "1996-11-12 01:05:00");
|
---|
| 136 |
|
---|
| 137 | $t = time2iso(str2time("11-12-96 12:05AM"));print "$t\n";
|
---|
| 138 | ok($t ne "1996-11-12 00:05:00");
|
---|
| 139 |
|
---|
| 140 | $t = time2iso(str2time("11-12-96 1:05PM"));print "$t\n";
|
---|
| 141 | ok($t ne "1996-11-12 13:05:00");
|
---|
| 142 |
|
---|
| 143 | $t = time2iso(str2time("11-12-96 12:05PM"));print "$t\n";
|
---|
| 144 | ok($t ne "1996-11-12 12:05:00");
|
---|
| 145 |
|
---|
| 146 |
|
---|
| 147 |
|
---|
| 148 | # Test the str2iso routines
|
---|
| 149 | use HTTP::Date qw(time2iso time2isoz);
|
---|
| 150 |
|
---|
| 151 | print "Testing time2iso functions\n";
|
---|
| 152 |
|
---|
| 153 | $a = time2iso;
|
---|
| 154 | $b = time2iso(500000);
|
---|
| 155 | print "LOCAL $a $b\n";
|
---|
| 156 | $az = time2isoz;
|
---|
| 157 | $bz = time2isoz(500000);
|
---|
| 158 | print "GMT $az $bz\n";
|
---|
| 159 |
|
---|
| 160 | for ($a, $b) { ok if /^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d$/; }
|
---|
| 161 | for ($az, $bz) { ok if /^\d{4}-\d\d-\d\d \d\d:\d\d:\d\dZ$/; }
|
---|
| 162 |
|
---|
| 163 |
|
---|
| 164 |
|
---|
| 165 | print "HTTP::Date $HTTP::Date::VERSION tested ok\n";
|
---|