tags/v1_29/t/internal/redirect.t

use Apache::testold;
use Config;

{
    package NoRedirect::UA;

    @ISA = qw(LWP::UserAgent);
    
    sub redirect_ok {0}
}

if(not $net::Is_Win32 and $Config{usesfio} eq "true") {
    print "1..1\n";
    print "ok 1\n";
    exit;
}

my $ua = NoRedirect::UA->new;

my $url = "http://$net::httpserver$net::perldir/io/redir.pl";
my $qredirect = "";

my($request,$response);

my $tests = 4;

$CGI::VERSION ||= 0;

if(have_module("CGI") && ($CGI::VERSION >= 2.37)) {
    $qredirect = "http://$net::httpserver$net::perldir/qredirect.pl";
    $tests += 2;
}

print "1..$tests\n";

$request = HTTP::Request->new(GET => "$url?internal");
$response = $ua->request($request, undef, undef);

unless (($response->code == 200) && ($response->content =~ /camel/)) {
    print "not ";
}

print "ok 1\n";


$request = HTTP::Request->new(GET => "$url?remote");
$response = $ua->request($request, undef, undef);

unless ($response->is_redirect && ($response->header("Location") =~ /perl.apache.org/)) {
    print "not ";
}
print "ok 2\n";

#print $response->as_string;

$request = HTTP::Request->new(GET => "$url?content");
$response = $ua->request($request, undef, undef);

unless ($response->content eq "OK") {
    print "not ";
}

print "ok 3\n";

print "content=`", $response->content, "'\n";

#test internal redirect
$request = HTTP::Request->new(GET => "http://$net::httpserver$net::perldir/io/redir1.pl");
$response = $ua->request($request, undef, undef);
unless ($response->content eq 'OK') {
    print "not ";
}
print "ok 4\n";
print "content=`", $response->content, "'\n";

if ($qredirect) {

    $request = HTTP::Request->new(GET => $qredirect);
    $response = $ua->request($request, undef, undef);

    if ($response->content =~ /Location: http/) {
        print "not ";
    }

    print "ok 5\n";

    print "content=`", $response->content, "'\n";

    $ua = LWP::UserAgent->new;
    $request = HTTP::Request->new(GET => $qredirect);
    $response = $ua->request($request, undef, undef);

    unless ($response->content eq "OK") {
        print "not ";
    }

    print "ok 6\n";

    print "content=`", $response->content, "'\n";


}