1# Test extra HTTP::Response methods.  Basic operation is tested in the
2# message.t test suite.
3
4use strict;
5use warnings;
6
7use Test::More;
8plan tests => 68;
9
10use HTTP::Date;
11use HTTP::Request;
12use HTTP::Response;
13
14# make sure we get no failures from undefined response values
15{
16    my $req = HTTP::Response->new();
17    is($req->is_success(), undef, 'Empty res: is_success');
18    is($req->is_info(), undef, 'Empty res: is_info');
19    is($req->is_redirect(), undef, 'Empty res: is_redirect');
20    is($req->is_error(), undef, 'Empty res: is_error');
21    is($req->is_client_error(), undef, 'Empty res: is_client_error');
22    is($req->is_server_error(), undef, 'Empty res: is_server_error');
23    is($req->filename(), undef, 'Empty res: filename');
24}
25
26my $time = time;
27
28my $req = HTTP::Request->new(GET => 'http://www.sn.no');
29$req->date($time - 30);
30
31my $r = HTTP::Response->new(200, "OK");
32$r->client_date($time - 20);
33$r->date($time - 25);
34$r->last_modified($time - 5000000);
35$r->request($req);
36
37#print $r->as_string;
38
39my $current_age = $r->current_age;
40
41ok($current_age >= 35  && $current_age <= 40);
42
43my $freshness_lifetime = $r->freshness_lifetime;
44ok($freshness_lifetime >= 12 * 3600);
45is($r->freshness_lifetime(heuristic_expiry => 0), undef);
46
47my $is_fresh = $r->is_fresh;
48ok($is_fresh);
49is($r->is_fresh(heuristic_expiry => 0), undef);
50
51print "# current_age        = $current_age\n";
52print "# freshness_lifetime = $freshness_lifetime\n";
53print "# response is ";
54print " not " unless $is_fresh;
55print "fresh\n";
56
57print "# it will be fresh for ";
58print $freshness_lifetime - $current_age;
59print " more seconds\n";
60
61# OK, now we add an Expires header
62$r->expires($time);
63print "\n", $r->dump(prefix => "# ");
64
65$freshness_lifetime = $r->freshness_lifetime;
66is($freshness_lifetime, 25);
67$r->remove_header('expires');
68
69# Now we try the 'Age' header and the Cache-Contol:
70$r->header('Age', 300);
71$r->push_header('Cache-Control', 'junk');
72$r->push_header(Cache_Control => 'max-age = 10');
73
74#print $r->as_string;
75
76$current_age = $r->current_age;
77$freshness_lifetime = $r->freshness_lifetime;
78
79print "# current_age        = $current_age\n";
80print "# freshness_lifetime = $freshness_lifetime\n";
81
82ok($current_age >= 300);
83is($freshness_lifetime, 10);
84
85ok($r->fresh_until);  # should return something
86ok($r->fresh_until(heuristic_expiry => 0));  # should return something
87
88my $r2 = HTTP::Response->parse($r->as_string( "\x0d\x0a"));
89is( $r2->message(), 'OK', 'message() returns as expected' );
90
91my @h = $r2->header('Cache-Control');
92is(@h, 2);
93
94$r->remove_header("Cache-Control");
95
96ok($r->fresh_until);  # should still return something
97is($r->fresh_until(heuristic_expiry => 0), undef);
98
99is($r->redirects, 0);
100$r->previous($r2);
101is($r->previous, $r2);
102is($r->redirects, 1);
103
104$r2->previous($r->clone);
105is($r->redirects, 2);
106for ($r->redirects) {
107    ok($_->is_success);
108}
109
110is($r->base, $r->request->uri);
111$r->push_header("Content-Location", "/1/A/a");
112is($r->base, "http://www.sn.no/1/A/a");
113$r->push_header("Content-Base", "/2/;a=/foo/bar");
114is($r->base, "http://www.sn.no/2/;a=/foo/bar");
115$r->push_header("Content-Base", "/3/");
116is($r->base, "http://www.sn.no/2/;a=/foo/bar");
117
118{
119	my @warn;
120	local $SIG{__WARN__} = sub { push @warn, @_ };
121	local $^W = 0;
122	$r2 = HTTP::Response->parse( undef );
123	is($#warn, -1);
124	local $^W = 1;
125	$r2 = HTTP::Response->parse( undef );
126	is($#warn, 0);
127	like($warn[0], qr/Undefined argument to parse\(\)/);
128}
129is($r2->code, undef);
130is($r2->message, undef);
131is($r2->protocol, undef);
132is($r2->status_line, "000 Unknown code");
133$r2->protocol('HTTP/1.0');
134is($r2->as_string("\n"), "HTTP/1.0 000 Unknown code\n\n");
135is($r2->dump, "HTTP/1.0 000 Unknown code\n\n(no content)\n");
136is($r2->current_age, 0);
137is($r2->freshness_lifetime, 3600);
138is($r2->freshness_lifetime(h_default => 900), 900);
139is($r2->freshness_lifetime(h_min => 7200), 7200);
140is($r2->freshness_lifetime(time => time), 3600);
141$r2->last_modified(time - 900);
142is($r2->freshness_lifetime, 90);
143is($r2->freshness_lifetime(h_lastmod_fraction => 0.2), 180);
144is($r2->freshness_lifetime(h_min => 300), 300);
145$r2->last_modified(time - 1000000);
146is($r2->freshness_lifetime(h_max => 7200), 7200);
147is($r2->freshness_lifetime(heuristic_expiry => 0), undef);
148is($r2->freshness_lifetime(heuristic_expiry => 1), 86400);
149ok($r2->is_fresh(time => time));
150ok($r2->fresh_until(time => time + 10));
151
152$r2->client_date(1);
153cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes
154is($r2->freshness_lifetime, 60);
155$r2->date(time);
156$r2->header(Age => -1);
157cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes
158is($r2->freshness_lifetime, 86400);
159$req = HTTP::Request->new;
160$r2->request($req);
161cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes
162$req->date(2);
163$r2->request($req);
164cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes
165
166$r2->header ('Content-Disposition' => "attachment; filename=foo.txt\n");
167is($r2->filename(), 'foo.txt');
168$r2->header ('Content-Disposition' => "attachment; filename=\n");
169is($r2->filename(), '');
170$r2->header ('Content-Disposition' => "attachment\n");
171is($r2->filename(), undef);
172$r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?B?Zm9vLnR4dA==?=\n");
173is($r2->filename(), 'foo.txt');
174$r2->header ('Content-Disposition' => "attachment; filename==?NOT-A-CHARSET?B?Zm9vLnR4dA==?=\n");
175is($r2->filename(), '=?NOT-A-CHARSET?B?Zm9vLnR4dA==?=');
176$r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?Z?Zm9vLnR4dA==?=\n");
177is($r2->filename(), '=?US-ASCII?Z?Zm9vLnR4dA==?=');
178$r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?Q?foo.txt?=\n");
179is($r2->filename(), 'foo.txt');
180$r2->remove_header ('Content-Disposition');
181$r2->header ('Content-Location' => '/tmp/baz.txt');
182is($r2->filename(), 'baz.txt');
183$r2->remove_header ('Content-Location');
184$req->uri('http://www.example.com/bar.txt');
185is($r2->filename(), 'bar.txt');
186