You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2004/07/17 02:16:21 UTC

cvs commit: modperl-2.0/t/response/TestAPI custom_response.pm response.pm

stas        2004/07/16 17:16:21

  Modified:    t/response/TestAPI response.pm
  Added:       t/api    custom_response.t
               t/response/TestAPI custom_response.pm
  Log:
  add a $r->custom_response test
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/api/custom_response.t
  
  Index: custom_response.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  use File::Spec::Functions qw(catfile);
  
  use Apache::Const -compile => qw(FORBIDDEN);
  
  my $module   = 'TestAPI::custom_response';
  my $location = '/' . Apache::TestRequest::module2path($module);
  
  my $config   = Apache::Test::config();
  my $hostport = Apache::TestRequest::hostport($config);
  t_debug("connecting to $hostport");
  
  my $file = catfile Apache::Test::vars('documentroot'),
      qw(api custom_response.txt);
  
  open my $fh, $file or die "Can't open $file: $!";
  my $data = do { local $/; <$fh> };
  close $fh;
  
  plan tests => 4;
  
  {
      # custom text response
      my $expected = "This_is_a_custom_text_response";
      my $res = GET "$location?$expected";
      ok t_cmp $res->code, Apache::FORBIDDEN, "custom text response (code)";
      ok t_cmp $res->content, $expected, "custom text response (body)";
  }
  
  {
      # custom relative url response
      my $url = "/api/custom_response.txt";
      my $res = GET "$location?$url";
      ok t_cmp $res->content, $data, "custom file response (body)";
  }
  {
      my $url = "http://$hostport/api/custom_response.txt";
      # custom full url response
      my $res = GET "$location?$url";
      ok t_cmp $res->content, $data, "custom file response (body)";
  }
  
  
  
  
  1.3       +1 -1      modperl-2.0/t/response/TestAPI/response.pm
  
  Index: response.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/response.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -u -r1.2 -r1.3
  --- response.pm	11 Apr 2002 11:08:43 -0000	1.2
  +++ response.pm	17 Jul 2004 00:16:20 -0000	1.3
  @@ -33,7 +33,7 @@
   
       $r->set_last_modified;
   
  -    $r->custom_response(500, "xxx");
  +    # custom_response is tested in TestAPI::custom_response
   
       ok 1;
   
  
  
  
  1.1                  modperl-2.0/t/response/TestAPI/custom_response.pm
  
  Index: custom_response.pm
  ===================================================================
  package TestAPI::custom_response;
  
  # custom_response() doesn't alter the response code, but is used to
  # replace the standard response body
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Response ();
  
  use Apache::Const -compile => qw(FORBIDDEN);
  
  sub access {
      my $r = shift;
  
      my $how = $r->args || '';
      # warn "$how";
      # could be text or url
      $r->custom_response(Apache::FORBIDDEN, $how);
  
      return Apache::FORBIDDEN;
  }
  
  1;
  __END__
  <NoAutoConfig>
  PerlModule TestAPI::custom_response
  <Location /TestAPI__custom_response>
      AuthName dummy
      AuthType none
      PerlAccessHandler TestAPI::custom_response::access
  </Location>
  </NoAutoConfig>