1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
use strict;
use Apache::test;
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) {
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 $!";
++$lines while (<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;
}
|
