t/17_version_cgi.t

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