cvs commit: modperl-2.0/t/response/TestApache compat.pm

[dougm]

dougm       01/05/04 12:04:19

  Modified:    lib/Apache compat.pm
  Added:       t/apache compat.t
               t/response/TestApache compat.pm
  Log:
  add 1.x versions of content and args, plus tests
  
  Revision  Changes    Path
  1.7       +36 -0     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.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- compat.pm 2001/05/04 18:19:37     1.6
  +++ compat.pm 2001/05/04 19:04:11     1.7
  @@ -53,6 +53,42 @@
   
   package Apache::RequestRec;
   
  +sub parse_args {
  +    my($r, $string) = @_;
  +    return () unless defined $string and $string;
  +
  +    return map {
  +        s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
  +        $_;
  +    } split /[=&;]/, $string, -1;
  +}
  +
  +#sorry, have to use $r->Apache::args at the moment
  +#for list context splitting
  +
  +sub Apache::args {
  +    my $r = shift;
  +    my $args = $r->args;
  +    return $args unless wantarray;
  +    return $r->parse_args($args);
  +}
  +
  +sub content {
  +    my $r = shift;
  +
  +    $r->setup_client_block;
  +
  +    return undef unless $r->should_client_block;
  +
  +    my $len = $r->headers_in->get('content-length');
  +
  +    my $buf;
  +    $r->get_client_block($buf, $len);
  +
  +    return $buf unless wantarray;
  +    return $r->parse_args($buf)
  +}
  +
   our $Request;
   
   sub request {
  
  
  
  1.1                  modperl-2.0/t/apache/compat.t
  
  Index: compat.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  
  plan tests => 2, \&have_lwp;
  
  my $location = "/TestApache::compat";
  my $str;
  
  my @data = (ok => '2');
  my %data = @data;
  
  $str = POST_BODY $location, \@data;
  
  ok $str eq "@data";
  
  my $q = join '=', @data;
  $str = GET_BODY "$location?$q";
  
  ok $str eq "@data";
  
  
  
  
  1.1                  modperl-2.0/t/response/TestApache/compat.pm
  
  Index: compat.pm
  ===================================================================
  package TestApache::compat;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::compat ();
  
  use Apache::Constants qw(OK M_POST);
  
  sub handler {
      my $r = shift;
  
      $r->send_http_header('text/plain');
  
      my %data;
      if ($r->method_number == M_POST) {
          %data = $r->content;
      }
      else {
          %data = $r->Apache::args;
      }
  
      $r->print("ok $data{ok}");
  
      OK;
  }
  
  1;