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

   1 #!/usr/local/bin/perl -w
   2 #
   3 # Check POST via HTTP.
   4 #
   5
   6 print "1..2\n";
   7
   8 require "net/config.pl";
   9 require LWP::Protocol::http;
  10 require LWP::UserAgent;
  11
  12 $netloc = $net::httpserver;
  13 $script = $net::cgidir . "/test";
  14
  15 my $ua = new LWP::UserAgent;    # create a useragent to test
  16
  17 $url = new URI::URL("http://$netloc$script");
  18
  19 my $form = 'searchtype=Substring';
  20
  21 my $request = new HTTP::Request('POST', $url, undef, $form);
  22 $request->header('Content-Type', 'application/x-www-form-urlencoded');
  23
  24 my $response = $ua->request($request, undef, undef);
  25
  26 my $str = $response->as_string;
  27
  28 print "$str\n";
  29
  30 if ($response->is_success and $str =~ /^REQUEST_METHOD=POST$/m) {
  31     print "ok 1\n";
  32 }
  33 else {
  34     print "not ok 1\n";
  35 }
  36
  37 if ($str =~ /^CONTENT_LENGTH=(\d+)$/m && $1 == length($form)) {
  38     print "ok 2\n";
  39 }
  40 else {
  41     print "not ok 2\n";
  42 }
  43
  44 # avoid -w warning
  45 $dummy = $net::httpserver;
  46 $dummy = $net::cgidir;