cvs commit: modperl-2.0/t/response/TestDirective perlloadmodule3.pm perlloadmodule4.pm perlloadmodule5.pm perlloadmodule6.pm

[st...@apache.org]

stas        2002/12/12 02:13:56

  Added:       t/directive perlloadmodule3.t perlloadmodule4.t
                        perlloadmodule5.t perlloadmodule6.t
               t/response/TestDirective perlloadmodule3.pm
                        perlloadmodule4.pm perlloadmodule5.pm
                        perlloadmodule6.pm
  Log:
  add various tests that exercise PerlLoadModule and vhosts
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/directive/perlloadmodule3.t
  
  Index: perlloadmodule3.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  my $module = "TestDirective::perlloadmodule3";
  my $config   = Apache::Test::config();
  my $base_hostport = Apache::TestRequest::hostport($config);
  
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  
  # XXX: probably a good idea to split into more tests, that test
  # smaller portions of information, but requires a more elaborated
  # logic.
  
  plan tests => 3;
  
  t_debug("connecting to $base_hostport");
  {
      my $expected = <<EOI;
  Processing by main server.
  
  Section 1: Main Server
  MyAppend   : MainServer
  MyList     : ["MainServer"]
  MyOverride : MainServer
  MyPlus     : 5
  
  Section 2: Location
  MyAppend   : MainServer
  MyList     : ["MainServer"]
  MyOverride : MainServer
  MyPlus     : 5
  EOI
      my $location = "http://$base_hostport/$module";
      my $received = GET_BODY $location;
      ok t_cmp($expected, $received, "server merge");
  }
  
  t_debug("connecting to $hostport");
  {
      my $expected = <<EOI;
  Processing by virtual host.
  
  Section 1: Main Server
  MyAppend   : MainServer
  MyList     : ["MainServer"]
  MyOverride : MainServer
  MyPlus     : 5
  
  Section 2: Virtual Host
  MyAppend   : MainServer VHost
  MyList     : ["MainServer", "VHost"]
  MyOverride : VHost
  MyPlus     : 7
  
  Section 3: Location
  MyAppend   : MainServer VHost Dir
  MyList     : ["MainServer", "VHost", "Dir"]
  MyOverride : Dir
  MyPlus     : 10
  EOI
      my $location = "http://$hostport/$module";
      my $received = GET_BODY $location;
      ok t_cmp($expected, $received, "server/dir merge");
  }
  
  {
      my $expected = <<EOI;
  Processing by virtual host.
  
  Section 1: Main Server
  MyAppend   : MainServer
  MyList     : ["MainServer"]
  MyOverride : MainServer
  MyPlus     : 5
  
  Section 2: Virtual Host
  MyAppend   : MainServer VHost
  MyList     : ["MainServer", "VHost"]
  MyOverride : VHost
  MyPlus     : 7
  
  Section 3: Location
  MyAppend   : MainServer VHost Dir SubDir
  MyList     : ["MainServer", "VHost", "Dir", "SubDir"]
  MyOverride : SubDir
  MyPlus     : 11
  EOI
  
      my $location = "http://$hostport/$module/subdir";
      my $received = GET_BODY $location;
      ok t_cmp($expected, $received, "server/dir/subdir merge");
  }
  
  
  
  1.1                  modperl-2.0/t/directive/perlloadmodule4.t
  
  Index: perlloadmodule4.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestRequest;
  
  my $module = "TestDirective::perlloadmodule4";
  my $config   = Apache::Test::config();
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  
  print GET_BODY "http://$hostport/$module";
  
  
  
  1.1                  modperl-2.0/t/directive/perlloadmodule5.t
  
  Index: perlloadmodule5.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestRequest;
  
  my $module = "TestDirective::perlloadmodule5";
  my $config   = Apache::Test::config();
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  
  print GET_BODY "http://$hostport/$module";
  
  
  
  1.1                  modperl-2.0/t/directive/perlloadmodule6.t
  
  Index: perlloadmodule6.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestRequest;
  
  my $module = "TestDirective::perlloadmodule6";
  my $config   = Apache::Test::config();
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  
  print GET_BODY "http://$hostport/$module";
  
  
  
  1.1                  modperl-2.0/t/response/TestDirective/perlloadmodule3.pm
  
  Index: perlloadmodule3.pm
  ===================================================================
  package TestDirective::perlloadmodule3;
  
  # in this test we test various merging techniques. As a side effect it
  # tests how mod_perl works when its forced to start early outside
  # vhosts and how it works with vhosts. See perlloadmodule4.pm and
  # perlloadmodule5.pm, for similar tests that starts mod_perl early
  # from a vhost.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::CmdParms ();
  use Apache::Module ();
  use Apache::ServerUtil ();
  
  use Apache::Const -compile => qw(OK);
  
  
  our @APACHE_MODULE_COMMANDS = (
      { name => 'MyPlus' },
      { name => 'MyList' },
      { name => 'MyAppend' },
      { name => 'MyOverride' },
  );
  
  sub MyPlus     { set_val('MyPlus',     @_) }
  sub MyAppend   { set_val('MyAppend',   @_) }
  sub MyOverride { set_val('MyOverride', @_) }
  sub MyList     { push_val('MyList',    @_) }
  
  sub DIR_MERGE    { merge(@_) }
  sub SERVER_MERGE { merge(@_) }
  
  sub set_val {
      my($key, $self, $parms, $arg) = @_;
      $self->{$key} = $arg;
      unless ($parms->path) {
          my $srv_cfg = Apache::Module->get_config($self, $parms->server);
          $srv_cfg->{$key} = $arg;
      }
  }
  
  sub push_val {
      my($key, $self, $parms, $arg) = @_;
      push @{ $self->{$key} }, $arg;
      unless ($parms->path) {
          my $srv_cfg = Apache::Module->get_config($self, $parms->server);
          push @{ $srv_cfg->{$key} }, $arg;
      }
  }
  
  sub merge {
      my($base, $add) = @_;
  
      my %mrg = ();
      for my $key (keys %$base, %$add) {
          next if exists $mrg{$key};
          if ($key eq 'MyPlus') {
              $mrg{$key} = ($base->{$key}||0) + ($add->{$key}||0);
          }
          elsif ($key eq 'MyList') {
              push @{ $mrg{$key} },
                  @{ $base->{$key}||[] }, @{ $add->{$key}||[] };
          }
          elsif ($key eq 'MyAppend') {
              $mrg{$key} = join " ", grep defined, $base->{$key}, $add->{$key};
          }
          else {
              # override mode
              $mrg{$key} = $base->{$key} if exists $base->{$key};
              $mrg{$key} = $add->{$key}  if exists $add->{$key};
          }
      }
  
      return bless \%mrg, ref($base);
  }
  
  ### response handler ###
  
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::Module ();
  
  use Apache::Const -compile => qw(OK);
  
  sub get_config {
      Apache::Module->get_config(__PACKAGE__, @_);
  }
  
  sub handler {
      my($r) = @_;
      my %secs = ();
  
      $r->content_type('text/plain');
  
      my $s = $r->server;
      my $dir_cfg = get_config($s, $r->per_dir_config);
      my $srv_cfg = get_config($s);
  
      if ($s->is_virtual) {
          $secs{"1: Main Server"}  = get_config(Apache->server);
          $secs{"2: Virtual Host"} = $srv_cfg;
          $secs{"3: Location"}     = $dir_cfg;
      }
      else {
          $secs{"1: Main Server"}  = $srv_cfg;
          $secs{"2: Location"}     = $dir_cfg;
       }
  
      $r->printf("Processing by %s.\n", 
          $s->is_virtual ? "virtual host" : "main server");
  
      for my $sec (sort keys %secs) {
          $r->print("\nSection $sec\n");
          for my $k (sort keys %{ $secs{$sec}||{} }) {
              my $v = exists $secs{$sec}->{$k} ? $secs{$sec}->{$k} : 'UNSET';
              $v = '[' . (join ", ", map {qq{"$_"}} @$v) . ']'
                  if ref($v) eq 'ARRAY';
              $r->printf("%-10s : %s\n", $k, $v);
          }
      }
  
      return Apache::OK;
  }
  
  
  
  1;
  __END__
  
  <Base>
      PerlLoadModule TestDirective::perlloadmodule3
      MyPlus 5
      MyList     "MainServer"
      MyAppend   "MainServer"
      MyOverride "MainServer"
  </Base>
  <VirtualHost TestDirective::perlloadmodule3>
      MyPlus 2
      MyList     "VHost"
      MyAppend   "VHost"
      MyOverride "VHost"
      <Location /TestDirective::perlloadmodule3>
          MyPlus 3
          MyList     "Dir"
          MyAppend   "Dir"
          MyOverride "Dir"
          SetHandler modperl
          PerlResponseHandler TestDirective::perlloadmodule3
      </Location>
      <Location /TestDirective::perlloadmodule3/subdir>
          MyPlus 1
          MyList     "SubDir"
          MyAppend   "SubDir"
          MyOverride "SubDir"
      </Location>
  </VirtualHost>
  
  
  
  1.1                  modperl-2.0/t/response/TestDirective/perlloadmodule4.pm
  
  Index: perlloadmodule4.pm
  ===================================================================
  package TestDirective::perlloadmodule4;
  
  # XXX: the package is 99% the same as perlloadlmodule5 and 6, just the
  # configuration is different. Consider removing the code dups.
  #
  # in this test we test an early mod_perl startup caused by an
  # EXEC_ON_READ directive in the baseserver. In this test the
  # non-native mod_perl directive sets scfg on behalf of mod_perl in
  # that vhost.
  #
  # See also perlloadmodule5.pm, which is almost the same, but uses a
  # mod_perl native directive before a non-native directive in vhost. In
  # that test mod_perl sets scfg for that vhost by itself.
  #
  # see perlloadmodule6.pm for the case where mod_perl starts early, but
  # from within the vhost.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::CmdParms ();
  use Apache::Module ();
  use Apache::ServerUtil ();
  
  use Apache::Const -compile => qw(OK);
  
  use constant KEY => "MyTest4";
  
  our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
  
  sub MyTest4 {
      my($self, $parms, $arg) = @_;
      $self->{+KEY} = $arg;
      unless ($parms->path) {
          my $srv_cfg = Apache::Module->get_config($self, $parms->server);
          $srv_cfg->{+KEY} = $arg;
      }
  }
  
  ### response handler ###
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::Module ();
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::Const -compile => qw(OK);
  
  sub get_config {
      Apache::Module->get_config(__PACKAGE__, @_);
  }
  
  sub handler {
      my($r) = @_;
      my %secs = ();
  
      $r->content_type('text/plain');
  
      my $s = $r->server;
      my $dir_cfg = get_config($s, $r->per_dir_config);
      my $srv_cfg = get_config($s);
  
      plan $r, tests => 3;
  
      ok $s->is_virtual;
  
      ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
  
      ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
  
      return Apache::OK;
  }
  
  1;
  __END__
  
  <Base>
      PerlLoadModule TestDirective::perlloadmodule4
  </Base>
  <VirtualHost TestDirective::perlloadmodule4>
      # here perlloadmodule sets scfg on behalf of the base server
      MyTest4 "Vhost"
      <Location /TestDirective::perlloadmodule4>
          MyTest4 "Dir"
          SetHandler modperl
          PerlResponseHandler TestDirective::perlloadmodule4
      </Location>
  </VirtualHost>
  
  
  
  
  1.1                  modperl-2.0/t/response/TestDirective/perlloadmodule5.pm
  
  Index: perlloadmodule5.pm
  ===================================================================
  package TestDirective::perlloadmodule5;
  
  # in this test we test an early mod_perl startup caused by an
  # EXEC_ON_READ directive in the baseserver. In this test we have a
  # mod_perl native directive before a non-native directive inside vhost
  # section. Here mod_perl sets scfg for that vhost by itself.
  #
  # See also perlloadmodule4.pm, which is almost the same, but has no
  # mod_perl native directive before a non-native directive in vhost. In
  # that test the non-native mod_perl directive sets scfg on behalf of
  # mod_perl in that vhost.
  #
  # see perlloadmodule6.pm for the case where mod_perl starts early, but
  # from within the vhost.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::CmdParms ();
  use Apache::Module ();
  use Apache::ServerUtil ();
  
  use Apache::Const -compile => qw(OK);
  
  use constant KEY => "MyTest5";
  
  our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
  
  sub MyTest5 {
      my($self, $parms, $arg) = @_;
      $self->{+KEY} = $arg;
      unless ($parms->path) {
          my $srv_cfg = Apache::Module->get_config($self, $parms->server);
          $srv_cfg->{+KEY} = $arg;
      }
  }
  
  ### response handler ###
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::Module ();
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::Const -compile => qw(OK);
  
  sub get_config {
      Apache::Module->get_config(__PACKAGE__, @_);
  }
  
  sub handler {
      my($r) = @_;
      my %secs = ();
  
      $r->content_type('text/plain');
  
      my $s = $r->server;
      my $dir_cfg = get_config($s, $r->per_dir_config);
      my $srv_cfg = get_config($s);
  
      plan $r, tests => 3;
  
      ok $s->is_virtual;
  
      ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
  
      ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
  
      return Apache::OK;
  }
  
  
  1;
  __END__
  <Base>
      PerlLoadModule TestDirective::perlloadmodule5
  </Base>
  <VirtualHost TestDirective::perlloadmodule5>
      # here mod_perl sets the scfg by itself for this vhost
      PerlModule CGI
      MyTest5 "Vhost"
      <Location /TestDirective::perlloadmodule5>
          MyTest5 "Dir"
          SetHandler modperl
          PerlResponseHandler TestDirective::perlloadmodule5
      </Location>
  </VirtualHost>
  
  
  
  1.1                  modperl-2.0/t/response/TestDirective/perlloadmodule6.pm
  
  Index: perlloadmodule6.pm
  ===================================================================
  package TestDirective::perlloadmodule6;
  
  # in this test we test an early mod_perl startup caused by an
  # EXEC_ON_READ directive in vhost.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::CmdParms ();
  use Apache::Module ();
  use Apache::ServerUtil ();
  
  use Apache::Const -compile => qw(OK);
  
  use constant KEY => "MyTest6";
  
  our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
  
  sub MyTest6 {
      my($self, $parms, $arg) = @_;
      $self->{+KEY} = $arg;
      unless ($parms->path) {
          my $srv_cfg = Apache::Module->get_config($self, $parms->server);
          $srv_cfg->{+KEY} = $arg;
      }
  }
  
  ### response handler ###
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::Module ();
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::Const -compile => qw(OK);
  
  sub get_config {
      Apache::Module->get_config(__PACKAGE__, @_);
  }
  
  sub handler {
      my($r) = @_;
      my %secs = ();
  
      $r->content_type('text/plain');
  
      my $s = $r->server;
      my $dir_cfg = get_config($s, $r->per_dir_config);
      my $srv_cfg = get_config($s);
  
      plan $r, tests => 3;
  
      ok $s->is_virtual;
  
      ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
  
      ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
  
      return Apache::OK;
  }
  
  1;
  __END__
  
  <VirtualHost TestDirective::perlloadmodule6>
      PerlLoadModule TestDirective::perlloadmodule6
      MyTest6 "Vhost"
      <Location /TestDirective::perlloadmodule6>
          MyTest6 "Dir"
          SetHandler modperl
          PerlResponseHandler TestDirective::perlloadmodule6
      </Location>
  </VirtualHost>