tags/v1_29/t/internal/http-post.t

#!/usr/local/bin/perl -w
#
# Check POST via HTTP.
#

use Config;

my $num_tests = 5;
my(@test_scripts) = qw(test);

#if($Config{usesfio} eq "true" or $] >= 5.003_93) {
if($] >= 5.003_93) {
    $num_tests += 2;
    push @test_scripts, qw(io/perlio.pl);
}

print "1..$num_tests\n";

use Apache::testold;
require LWP::UserAgent;

my $ua = new LWP::UserAgent;    # create a useragent to test

my($request,$response,$str,$form);

foreach $script (@test_scripts) {
    $netloc = $net::httpserver;
    $script = $PERL_DIR . "/$script";

    $ua = new LWP::UserAgent;    # create a useragent to test

    $url = new URI::URL("http://$netloc$script");

    $form = 'searchtype=Substring';

    $request = new HTTP::Request('POST', $url, undef, $form);
    $request->header('Content-Type', 'application/x-www-form-urlencoded');

    $response = $ua->request($request, undef, undef);

    $str = $response->as_string;
    print "$str\n";

    die "$1\n" if $str =~ /(Internal Server Error)/;

    test ++$i, ($response->is_success and $str =~ /^REQUEST_METHOD=POST$/m);
    test ++$i, ($str =~ /^CONTENT_LENGTH=(\d+)$/m && $1 == length($form));
}

print "pounding a bit...\n";
for (1..3) {
    test ++$i, ($ua->request($request, undef, undef)->is_success);
}


# avoid -w warning
$dummy = $net::httpserver;
$dummy = $net::perldir;