git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/net/http-timeout.t

   1 #
   2 # Check timeouts via HTTP.
   3 #
   4
   5 print "1..1\n";
   6
   7 require "net/config.pl";
   8 require HTTP::Status;
   9 require LWP::Protocol::http;
  10 require LWP::UserAgent;
  11
  12 my $ua = new LWP::UserAgent;    # create a useragent to test
  13
  14 $ua->timeout(4);
  15
  16 $netloc = $net::httpserver;
  17 $script = $net::cgidir . "/timeout";
  18
  19 $url = new URI::URL("http://$netloc$script");
  20
  21 my $request = new HTTP::Request('GET', $url);
  22
  23 print $request->as_string;
  24
  25 my $response = $ua->request($request, undef);
  26
  27 my $str = $response->as_string;
  28
  29 print "$str\n";
  30
  31 if ($response->is_error and
  32     $str =~ /timeout/) {
  33     print "ok 1\n";
  34 }
  35 else {
  36     print "nok ok 1\n";
  37 }
  38
  39 # avoid -w warning
  40 $dummy = $net::httpserver;
  41 $dummy = $net::cgidir;