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

[stas]

stas        2003/10/14 17:43:24

  Added:       t/api    internal_redirect.t
               t/response/TestAPI internal_redirect.pm
  Log:
  internal redirect tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/api/internal_redirect.t
  
  Index: internal_redirect.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  # test internal redirects originating from 'SetHandler modperl' and
  # 'SetHandler perl-script' main handlers, and sub-requests handled by
  # the handlers of the same and the opposite kind
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  my $uri = "/TestAPI__internal_redirect";
  
  my %map = (
      "modperl => modperl"         => "${uri}_modperl?uri=${uri}_modperl",
      "perl-script => modperl"     => "${uri}_perl_script?uri=${uri}_modperl",
      "perl-script => perl-script" => "${uri}_perl_script?uri=${uri}_perl_script",
      "modperl => perl-script"     => "${uri}_modperl?uri=${uri}_perl_script",
  );
  
  plan tests => 4;
  
  while (my($key, $val) = each %map) {
      my $expected = "internal redirect: $key";
      my $received = GET_BODY_ASSERT $val;
      ok t_cmp($expected, $received);
  }
  
  
  
  1.1                  modperl-2.0/t/response/TestAPI/internal_redirect.pm
  
  Index: internal_redirect.pm
  ===================================================================
  package TestAPI::internal_redirect;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::SubRequest ();
  
  use Apache::Const -compile => 'OK';
  
  sub modperl {
      my $r = shift;
  
      my %args = map { split('=', $_, 2) } split /[&]/, $r->args;
      if ($args{main}) {
          # sub-req
          $r->content_type('text/plain');
          $r->print("internal redirect: $args{main} => modperl");
      }
      else {
          # main-req
          my $redirect_uri = $args{uri};
          $r->internal_redirect("$redirect_uri?main=modperl");
      }
  
      Apache::OK;
  }
  
  sub perl_script {
      my $r = shift;
  
      my %args = map { split('=', $_, 2) } split /[&]/, $r->args;
      if ($args{main}) {
          # sub-req
          $r->content_type('text/plain');
          print "internal redirect: $args{main} => perl-script";
      }
      else {
          # main-req
          my $redirect_uri = $args{uri};
          $r->internal_redirect("$redirect_uri?main=perl-script");
      }
  
      Apache::OK;
  }
  1;
  __DATA__
  <NoAutoConfig>
      PerlModule TestAPI::internal_redirect
      <Location /TestAPI__internal_redirect_modperl>
          SetHandler modperl
          PerlResponseHandler TestAPI::internal_redirect::modperl
      </Location>
      <Location /TestAPI__internal_redirect_perl_script>
          SetHandler perl-script
          PerlResponseHandler TestAPI::internal_redirect::perl_script
      </Location>
  </NoAutoConfig>