cvs commit: modperl-2.0/t/hooks/TestHooks startup.pm

[st...@apache.org]

stas        2003/12/22 16:31:03

  Added:       t/hooks  startup.t
               t/hooks/TestHooks startup.pm
  Log:
  not a day without a new test:
  - test PerlPostConfigHandler and PerlOpenLogsHandler phases
  - also test that we can run things on vhost entries from these phases
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/hooks/startup.t
  
  Index: startup.t
  ===================================================================
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  my $config = Apache::Test::config();
  my $path = Apache::TestRequest::module2path('TestHooks::startup');
  
  my @modules = qw(default TestHooks::startup);
  
  plan tests => scalar @modules;
  
  my $expected = join '', "open_logs ok\n", "post_config ok\n";
  
  for my $module (sort @modules) {
  
      Apache::TestRequest::module($module);
      my $hostport = Apache::TestRequest::hostport($config);
      t_debug("connecting to $hostport");
  
      ok t_cmp($expected,
               GET_BODY_ASSERT("http://$hostport/$path"),
               "testing PostConfig");
  }
  
  
  
  
  1.1                  modperl-2.0/t/hooks/TestHooks/startup.pm
  
  Index: startup.pm
  ===================================================================
  package TestHooks::startup;
  
  # test PerlPostConfigHandler and PerlOpenLogsHandler phases
  # also test that we can run things on vhost entries from these phases
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestUtil;
  use Apache::Test;
  use Apache::TestTrace;
  
  use APR::Table;
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  use File::Spec::Functions qw(catfile catdir);
  use File::Path qw(mkpath);
  
  use Apache::Const -compile => 'OK';
  
  my $dir = catdir Apache::Test::config()->{vars}->{documentroot}, 'hooks',
      'startup';
  
  sub open_logs {
      my($conf_pool, $log_pool, $temp_pool, $s) = @_;
  
      # main server
      run("open_logs", $s);
  
      for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
          my $port = $vhost_s->port;
          my $val = $vhost_s->dir_config->{PostConfig};
          # we have one vhost that we want to run open_logs for
          next unless $val && $val eq 'VHost';
          run("open_logs", $vhost_s);
      }
  
      Apache::OK;
  }
  
  sub post_config {
      my($conf_pool, $log_pool, $temp_pool, $s) = @_;
  
      # main server
      run("post_config", $s);
  
      for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
          my $port = $vhost_s->port;
          my $val = $vhost_s->dir_config->{PostConfig};
          # we have one vhost that we want to run post_config for
          next unless $val && $val eq 'VHost';
          run("post_config", $vhost_s);
      }
  
      Apache::OK;
  }
  
  sub run {
      my($phase, $s) = @_;
  
      my $val = $s->dir_config->{PostConfig} or die "Can't read PostConfig var";
  
      my $port = $s->port;
      my $file = catfile $dir, "$phase-$port";
  
      mkpath $dir, 0, 0755;
      open my $fh, ">$file" or die "can't open $file: $!";
      print $fh $val;
      close $fh;
  
      debug "Phase $phase is completed for server at port $port";
  }
  
  sub handler {
      my $r = shift;
  
      $r->content_type('text/plain');
  
      my $s = $r->server;
      my $expected = $s->dir_config->{PostConfig}
          or die "Can't read PostConfig var";
      my $port = $s->port;
  
      for my $phase (qw(open_logs post_config)) {
          my $file = catfile $dir, "$phase-$port";
          open my $fh, "$file" or die "can't open $file: $!";
          my $received = <$fh> || '';
          close $fh;
  
          # cleanup
          unlink $file;
  
          if ($expected eq $received) {
              $r->print("$phase ok\n");
          } else {
              warn "phase: $phase\n";
              warn "port: $port\n";
              warn "expected: $expected\n";
              warn "received: $received\n";
          }
      }
      Apache::OK;
  }
  
  1;
  __DATA__
  <NoAutoConfig>
  <VirtualHost TestHooks::startup>
      PerlSetVar PostConfig VHost
      PerlModule TestHooks::startup
      PerlPostConfigHandler TestHooks::startup::post_config
      PerlOpenLogsHandler   TestHooks::startup::open_logs
      <Location /TestHooks__startup>
          SetHandler modperl
          PerlResponseHandler TestHooks::startup
      </Location>
  </VirtualHost>
  PerlSetVar PostConfig Main
  PerlModule TestHooks::startup
  PerlPostConfigHandler TestHooks::startup::post_config
  PerlOpenLogsHandler   TestHooks::startup::open_logs
  <Location /TestHooks__startup>
      SetHandler modperl
      PerlResponseHandler TestHooks::startup
  </Location>
  </NoAutoConfig>