git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/live/apache.t

   1 print "1..1\n";
   2
   3 use strict;
   4 use Net::HTTP;
   5
   6
   7 my $s = Net::HTTP->new(Host => "www.apache.org",
   8                        KeepAlive => 1,
   9                        Timeout => 15,
  10                        PeerHTTPVersion => "1.1",
  11                        MaxLineLength => 512) || die "$@";
  12
  13 for (1..1) {
  14     $s->write_request(TRACE => "/libwww-perl",
  15                       'User-Agent' => 'Mozilla/5.0',
  16                       'Accept-Language' => 'no,en',
  17                       Accept => '*/*');
  18
  19     my($code, $mess, %h) = $s->read_response_headers;
  20     print "# $code $mess\n";
  21     for (sort keys %h) {
  22         print "# $_: $h{$_}\n";
  23     }
  24     print "\n";
  25
  26     my $err;
  27     $err++ unless $code eq "200";
  28     $err++ unless $h{'Content-Type'} eq "message/http";
  29
  30     my $buf;
  31     while (1) {
  32         my $tmp;
  33         my $n = $s->read_entity_body($tmp, 20);
  34         last unless $n;
  35         $buf .= $tmp;
  36     }
  37     $buf =~ s/\r//g;
  38
  39     $err++ unless $buf eq "TRACE /libwww-perl HTTP/1.1
  40 Host: www.apache.org
  41 User-Agent: Mozilla/5.0
  42 Accept-Language: no,en
  43 Accept: */*
  44
  45 ";
  46
  47     print "not " if $err;
  48     print "ok $_\n";
  49 }
  50