tags/v1_29/t/modules/request.t

use strict;
use Apache::testold;
use Apache::src ();
use Cwd qw(fastcwd);

my $Is_dougm = (defined($ENV{USER}) && ($ENV{USER} eq "dougm"));

skip_test unless have_module "Apache::Request", '0.20';

unless (Apache::src->mmn_eq) {
    skip_test if not $Is_dougm;
}

require HTTP::Request::Common; 
require CGI;

$HTTP::Request::Common::VERSION ||= '1.00'; #-w 
unless ($CGI::VERSION >= 2.39 and  
	$HTTP::Request::Common::VERSION >= 1.08) {
    print "CGI.pm: $CGI::VERSION\n";
    print "HTTP::Request::Common: $HTTP::Request::Common::VERSION\n";
    skip_test;
} 

my $PWD = fastcwd;
my @binary = "$PWD/docs/book.gif";

my $test_pods = $ENV{UPLOAD_PODS} || ($Is_dougm ? 20 : 3);
my $tests = 2;

unless ($USE_SFIO) {
    $tests += ($test_pods * 2) + (@binary * 2);
}

print "1..$tests\n";
my $i = 0;
my $ua = LWP::UserAgent->new;

use DirHandle ();

for my $cv (\&post_test, \&get_test) {
    $cv->();
}

exit(0) if $USE_SFIO;

if ($Is_dougm) {
    for (@binary) {
	upload_test($_);
    }
    #try various sizes
    my $dir = "";
    for my $path (@INC, $ENV{PERL_POD_LIB}) {
	last if -d ($dir = "$path/pod");
    }
    my $dh = DirHandle->new($dir) or die $!;
    my $num = $test_pods;
    for ($dh->read) {
	next unless /\.pod$/;
	last unless $num-- > 0;
	upload_test($_);
    }
}
else {
    for (qw(perlfunc.pod perlpod.pod perlxs.pod), @binary) {
	upload_test($_);
    }
}

sub post_test {
    my $enc = 'application/x-www-form-urlencoded';
    param_test(sub {
	my($url, $data) = @_;
        HTTP::Request::Common::POST($url, 
				    Content_Type => $enc,
				    Content      => $data,
				    );
    });
}

sub get_test {
    my $enc = 'application/x-www-form-urlencoded';

    param_test(sub {
	my($url, $data) = @_;
        HTTP::Request::Common::GET("$url?$data");
    });
}

sub param_test {
    my $cv = shift;
    my $url = "http://$net::httpserver$net::perldir/request-param.pl";
    my $data = 
	"ONE=ONE_value&TWO=TWO_value&" .
	"THREE=M1&THREE=M2&THREE=M3";
		
    my $response = $ua->request($cv->($url, $data));

    my $page = $response->content;
    print $response->as_string unless $response->is_success;
    my $expect = <<EOF;
param ONE => ONE_value
param TWO => TWO_value
param THREE => M1,M2,M3
EOF
    my $ok = $page eq $expect;
    test ++$i, $ok;
    print $response->as_string unless $ok;
}

sub upload_test {
    my $podfile = shift || "func";
    my $url = "http://$net::httpserver$net::perldir/request-upload.pl";
    my $file = "";
    if (-e $podfile) {
	$file = $podfile;
    }
    else {
	for my $path (@INC) {
	    last if -e ($file = "$path/pod/$podfile");
	}
    }

    $file = $0 unless -e $file;
    my $lines = 0;
    local *FH;
    open FH, $file or die "open $file $!";
    binmode FH; #for win32
    ++$lines while defined <FH>;
    close FH;
    my(@headers);
    if ($Is_dougm) {
	my $dir = "$ENV{HOME}/public_html/tmp/uploads";
	mkdir $dir, 0755;
	push @headers, "X-Upload-Tmp" => $dir if -d $dir;
    }
    my $response = $ua->request(HTTP::Request::Common::POST($url,
                   @headers,
		   Content_Type => 'multipart/form-data',
		   Content      => [count => 'count lines',
				    filename  => [$file],
				    ]));

    my $page = $response->content;
    print $response->as_string unless $response->is_success;
    test ++$i, ($page =~ m/Lines:\s+(\d+)/m);
    print "$file should have $lines lines (request-upload.pl says: $1)\n"
	unless $1 == $lines;
    test ++$i, $1 == $lines;
}