stas 2002/12/15 00:30:40
Modified: . Changes
lib/Apache compat.pm
t/conf modperl_extra.pl
t/compat request_body.t
t/response/TestCompat request_body.pm
Log:
fix the method content() in Apache::compat to read a whole request
body. same for ModPerl::Test::read_post. add tests.
Revision Changes Path
1.84 +3 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- Changes 15 Dec 2002 07:43:40 -0000 1.83
+++ Changes 15 Dec 2002 08:30:39 -0000 1.84
@@ -10,6 +10,9 @@
=item 1.99_08-dev
+fix the method content() in Apache::compat to read a whole request
+body. same for ModPerl::Test::read_post. add tests. [Stas]
+
Adjust the reverse filter test to work on win32 (remove trailing \r)
[Randy Kobes <[EMAIL PROTECTED]>]
1.75 +11 -7 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- compat.pm 6 Dec 2002 13:09:15 -0000 1.74
+++ compat.pm 15 Dec 2002 08:30:40 -0000 1.75
@@ -241,6 +241,8 @@
return $r->parse_args($args);
}
+use constant IOBUFSIZE => 8192;
+
sub content {
my $r = shift;
@@ -248,13 +250,17 @@
return undef unless $r->should_client_block;
- my $len = $r->headers_in->get('content-length');
-
+ my $data = '';
my $buf;
- $r->get_client_block($buf, $len);
+ while (my $read_len = $r->get_client_block($buf, IOBUFSIZE)) {
+ if ($read_len == -1) {
+ die "some error while reading with get_client_block";
+ }
+ $data .= $buf;
+ }
- return $buf unless wantarray;
- return $r->parse_args($buf)
+ return $data unless wantarray;
+ return $r->parse_args($data);
}
sub clear_rgy_endav {
@@ -316,8 +322,6 @@
$r->read($line, $r->headers_in->get('Content-length'));
$line ? $line : undef;
}
-
-use constant IOBUFSIZE => 8192;
#XXX: howto convert PerlIO to apr_file_t
#so we can use the real ap_send_fd function
1.21 +10 -4 modperl-2.0/t/conf/modperl_extra.pl
Index: modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- modperl_extra.pl 7 Oct 2002 02:35:18 -0000 1.20
+++ modperl_extra.pl 15 Dec 2002 08:30:40 -0000 1.21
@@ -47,6 +47,8 @@
$server->log->info("base server + $vhosts vhosts ready to run tests");
}
+use constant IOBUFSIZE => 8192;
+
sub ModPerl::Test::read_post {
my $r = shift;
@@ -54,12 +56,16 @@
return undef unless $r->should_client_block;
- my $len = $r->headers_in->get('content-length');
-
+ my $data = '';
my $buf;
- $r->get_client_block($buf, $len);
+ while (my $read_len = $r->get_client_block($buf, IOBUFSIZE)) {
+ if ($read_len == -1) {
+ die "some error while reading with get_client_block";
+ }
+ $data .= $buf;
+ }
- return $buf;
+ return $data;
}
sub ModPerl::Test::add_config {
1.2 +30 -16 modperl-2.0/t/compat/request_body.t
Index: request_body.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/compat/request_body.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- request_body.t 15 Aug 2002 09:35:11 -0000 1.1
+++ request_body.t 15 Dec 2002 08:30:40 -0000 1.2
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest;
-plan tests => 3;
+plan tests => 5;
my $location = "/TestCompat::request_body";
@@ -41,6 +41,35 @@
);
}
+# encoding/decoding
+{
+ my %data = (
+ test => 'decoding',
+ body => '%DC%DC+%EC%2E+%D6%D6+%D6%2F',
+ );
+ ok t_cmp(
+ $data{body},
+ GET_BODY(query(%data)),
+ q{decoding}
+ );
+}
+
+
+# big POST
+{
+ my %data = (
+ test => 'big_input',
+ body => ('x' x 819_235),
+ );
+ my $content = join '=', %data;
+ ok t_cmp(
+ length($data{body}),
+ POST_BODY($location, content => $content),
+ q{big POST}
+ );
+}
+
+
### helper subs ###
sub query {
@@ -48,18 +77,3 @@
"$location?" . join '&', map { "$_=$args{$_}" } keys %args;
}
-# accepts multiline var where, the lines matching:
-# ^ok\n$ results in ok(1)
-# ^nok\n$ results in ok(0)
-# the rest is printed as is
-sub ok_nok {
- for (split /\n/, shift) {
- if (/^ok\n?$/) {
- ok 1;
- } elsif (/^nok\n?$/) {
- ok 0;
- } else {
- print "$_\n";
- }
- }
-}
1.2 +16 -2 modperl-2.0/t/response/TestCompat/request_body.pm
Index: request_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestCompat/request_body.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- request_body.pm 15 Aug 2002 09:35:11 -0000 1.1
+++ request_body.pm 15 Dec 2002 08:30:40 -0000 1.2
@@ -36,12 +36,26 @@
if ($data{test} eq 'content' || $data{test} eq 'args') {
$r->print("test $data{test}");
}
+ elsif ($data{test} eq 'decoding') {
+ $r->print(encode($data{body}));
+ }
+ elsif ($data{test} eq 'big_input') {
+ $r->print(length $data{body});
+ }
+ else {
+ # nothing
+ }
OK;
}
-sub ok { $gr->print($_[0] ? "ok\n" : "nok\n"); }
-sub debug { $gr->print("# $_\n") for @_; }
+sub encode {
+ my $val = shift;
+ $val =~ s/(.)/sprintf "%%%02X", ord $1/eg;
+ $val =~ s/\%20/+/g;
+ return $val;
+}
+
1;
__END__
