1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
# -*- mode: cperl;-*-
use warnings;
use strict;
use Test::More;
# The test functions are placed here to make things easier
use lib qw(t/lib);
use DebbugsTest qw(:all);
plan tests => 3;
my $port = 11344;
my $version_cgi_handler = sub {
my $fh;
open($fh,'-|',-e './cgi/version.cgi'? './cgi/version.cgi' : '../cgi/version.cgi');
my $headers;
my $status = 200;
while (<$fh>) {
if (/^\s*$/ and $status) {
print "HTTP/1.1 $status OK\n";
print $headers;
$status = 0;
print $_;
} elsif ($status) {
$headers .= $_;
if (/^Status:\s*(\d+)/i) {
$status = $1;
}
} else {
print $_;
}
}
};
ok(DebbugsTest::HTTPServer::fork_and_create_webserver($version_cgi_handler,$port),
'forked HTTP::Server::Simple successfully');
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("DebbugsTesting/0.1 ");
# Create a request
my $req = HTTP::Request->new(GET => "http://localhost:$port/");
my $res = $ua->request($req);
ok($res->is_success(),'cgi/version.cgi returns success');
my $etag = $res->header('Etag');
$req = HTTP::Request->new(GET => "http://localhost:$port/",['If-None-Match',$etag]);
$res = $ua->request($req);
ok($res->code() eq '304','If-None-Match set gives us 304 not modified');
|
