Return-Path: Delivered-To: apmail-modperl-cvs-archive@apache.org Received: (qmail 98883 invoked by uid 500); 15 Dec 2002 08:30:42 -0000 Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Reply-To: dev@perl.apache.org Delivered-To: mailing list modperl-cvs@apache.org Received: (qmail 98870 invoked by uid 500); 15 Dec 2002 08:30:42 -0000 Delivered-To: apmail-modperl-2.0-cvs@apache.org Date: 15 Dec 2002 08:30:40 -0000 Message-ID: <20021215083040.43825.qmail@icarus.apache.org> From: stas@apache.org To: modperl-2.0-cvs@apache.org Subject: cvs commit: modperl-2.0/t/response/TestCompat request_body.pm X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N 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 ] 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__