perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestCompat request_body.pm
Date Sun, 15 Dec 2002 08:30:40 GMT
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 <randy@theoryx5.uwinnipeg.ca>]
   
  
  
  
  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__
  
  
  

Mime
View raw message