cvs commit: modperl-2.0/t/hooks hookrun.t

[stas]

stas        2004/08/17 22:49:03

  Added:       t/hooks/TestHooks hookrun.pm
               t/hooks  hookrun.t
  Log:
  Apache::HookRun tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/hooks/TestHooks/hookrun.pm
  
  Index: hookrun.pm
  ===================================================================
  package TestHooks::hookrun;
  
  # this test runs all Apache phases from within the very first http
  # phase
  
  # XXX: may be improve the test to do a full-blown test, where each
  # phase does something useful.
  
  # see also TestProtocol::pseudo_http
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestUtil ();
  use Apache::HookRun ();
  use APR::Table ();
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use Apache::Const -compile => qw(OK DECLINED DONE SERVER_ERROR);
  
  my $path = '/' . Apache::TestRequest::module2path(__PACKAGE__);
  
  my @phases = qw(
      PerlPostReadRequestHandler
      PerlTransHandler
      PerlMapToStorageHandler
      PerlHeaderParserHandler
      PerlAccessHandler
      PerlAuthenHandler
      PerlAuthzHandler
      PerlTypeHandler
      PerlFixupHandler
      PerlResponseHandler
      PerlLogHandler
  );
  
  sub post_read_request {
      my $r = shift;
      my $rc;
  
      $r->push_handlers(PerlTransHandler        => \&any);
      $r->push_handlers(PerlMapToStorageHandler => \&any);
      $r->push_handlers(PerlHeaderParserHandler => \&any);
      $r->push_handlers(PerlAccessHandler       => \&any);
      $r->push_handlers(PerlAuthenHandler       => \&any);
      $r->push_handlers(PerlAuthzHandler        => \&any);
      $r->push_handlers(PerlTypeHandler         => \&any);
      $r->push_handlers(PerlFixupHandler        => \&any);
      $r->push_handlers(PerlLogHandler          => \&any);
  
      any($r); # indicate that the post_read_request phase was run
  
      # for the full Apache logic for running phases starting from
      # post_read_request and ending with fixup see
      # ap_process_request_internal in httpd-2.0/server/request.c
  
      $rc = $r->run_translate_name;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_map_to_storage;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      # this must be run all a big havoc will happen in the following
      # phases
      $r->location_merge($path);
  
      $rc = $r->run_header_parser;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      my $args = $r->args || '';
      if ($args eq 'die') {
          $r->die(Apache::SERVER_ERROR);
          return Apache::DONE;
      }
  
      $rc = $r->run_access_checker;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_auth_checker;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_check_user_id;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_type_checker;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_fixups;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      # $r->run_handler is called internally by $r->invoke_handler,
      # invoke_handler sets all kind of filters, and does a few other
      # things but it's possible to call $r->run_handler, bypassing
      # invoke_handler
      $rc = $r->invoke_handler;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      $rc = $r->run_log_transaction;
      return $rc unless $rc == Apache::OK or $rc == Apache::DECLINED;
  
      return Apache::DONE;
  
      # Apache runs ap_finalize_request_protocol on return of this
      # handler
  }
  
  sub any {
      my $r = shift;
  
      my $callback = Apache::current_callback();
  
      debug "running $callback\n";
      $r->notes->set($callback => 1);
  
      # unset the callback that was already run
      $r->set_handlers($callback => []);
  
      Apache::OK;
  }
  
  sub response {
      my $r = shift;
  
      my @pre_response = (@phases)[0..($#phases-2)];
      plan tests => scalar(@pre_response);
  
      for my $phase (@pre_response) {
          my $note = $r->notes->get($phase);
          $r->print("$phase:$note\n");
      }
  
      Apache::OK;
  }
  
  1;
  __END__
  <NoAutoConfig>
  <VirtualHost TestHooks::hookrun>
      PerlModule                 TestHooks::hookrun
      PerlPostReadRequestHandler Apache::Reload
      PerlPostReadRequestHandler TestHooks::hookrun::post_read_request
      <Location /TestHooks__hookrun>
          SetHandler modperl
          PerlResponseHandler    TestHooks::hookrun::response
  
          AuthName modperl
          AuthType none
          Require valid-user
      </Location>
  </VirtualHost>
  </NoAutoConfig>
  
  
  
  1.1                  modperl-2.0/t/hooks/hookrun.t
  
  Index: hookrun.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  my $module = 'TestHooks::hookrun';
  my $config = Apache::Test::config();
  my $path = Apache::TestRequest::module2path($module);
  
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  t_debug("connecting to $hostport");
  
  plan tests => 10;
  
  my $ret = GET "http://$hostport/$path?die";;
  ok t_cmp $ret->code, 500, '$r->die';
  
  my $body = GET_BODY_ASSERT "http://$hostport/$path?normal";;
  for my $line (split /\n/, $body) {
      my($phase, $value) = split /:/, $line;
      ok t_cmp $value, 1, "$phase";
  }