Adding debian version 2.4.63-1.
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
This commit is contained in:
parent
7263481e48
commit
f56986e2d9
GPG key ID:
BCC918A2ABD66424
1490 changed files with 80785 additions and 0 deletions
654
debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
vendored
Normal file
654
debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
vendored
Normal file
|
|
@ -0,0 +1,654 @@
|
|||
# Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
# contributor license agreements. See the NOTICE file distributed with
|
||||
# this work for additional information regarding copyright ownership.
|
||||
# The ASF licenses this file to You under the Apache License, Version 2.0
|
||||
# (the "License"); you may not use this file except in compliance with
|
||||
# the License. You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
#
|
||||
package Apache::TestConfig; #not TestConfigPerl on purpose
|
||||
|
||||
#things specific to mod_perl
|
||||
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use File::Spec::Functions qw(catfile splitdir abs2rel file_name_is_absolute);
|
||||
use File::Find qw(finddepth);
|
||||
use Apache::TestTrace;
|
||||
use Apache::TestRequest;
|
||||
use Config;
|
||||
|
||||
my %libmodperl = (1 => 'libperl.so', 2 => 'mod_perl.so');
|
||||
|
||||
sub configure_libmodperl {
|
||||
my $self = shift;
|
||||
|
||||
my $server = $self->{server};
|
||||
my $libname = $server->version_of(\%libmodperl);
|
||||
my $vars = $self->{vars};
|
||||
|
||||
if ($vars->{libmodperl}) {
|
||||
# if set, libmodperl was specified from the command line and
|
||||
# should be used instead of the one that is looked up
|
||||
|
||||
# resolve a non-absolute path
|
||||
$vars->{libmodperl} = $self->find_apache_module($vars->{libmodperl})
|
||||
unless file_name_is_absolute($vars->{libmodperl});
|
||||
}
|
||||
# $server->{rev} could be set to 2 as a fallback, even when
|
||||
# the wanted version is 1. So check that we use mod_perl 2
|
||||
elsif ($server->{rev} >= 2 && IS_MOD_PERL_2) {
|
||||
|
||||
if (my $build_config = $self->modperl_build_config()) {
|
||||
if ($build_config->{MODPERL_LIB_SHARED}) {
|
||||
$libname = $build_config->{MODPERL_LIB_SHARED};
|
||||
$vars->{libmodperl} ||= $self->find_apache_module($libname);
|
||||
} else {
|
||||
$vars->{libmodperl} ||= $self->find_apache_module('mod_perl.so');
|
||||
}
|
||||
# XXX: we have a problem with several perl trees pointing
|
||||
# to the same httpd tree. So it's possible that we
|
||||
# configure the test suite to run with mod_perl.so built
|
||||
# against perl which it wasn't built with. Should we use
|
||||
# something like ldd to check the match?
|
||||
#
|
||||
# For now, we'll default to the first mod_perl.so found.
|
||||
}
|
||||
else {
|
||||
# XXX: can we test whether mod_perl was linked statically
|
||||
# so we don't need to preload it
|
||||
# if (!linked statically) {
|
||||
# die "can't find mod_perl built for perl version $]"
|
||||
# }
|
||||
error "can't find mod_perl.so built for perl version $]";
|
||||
}
|
||||
# don't use find_apache_module or we may end up with the wrong
|
||||
# shared object, built against different perl
|
||||
}
|
||||
else {
|
||||
# mod_perl 1.0
|
||||
$vars->{libmodperl} ||= $self->find_apache_module($libname);
|
||||
# XXX: how do we find out whether we have a static or dynamic
|
||||
# mod_perl build? die if its dynamic and can't find the module
|
||||
}
|
||||
|
||||
my $cfg = '';
|
||||
|
||||
if ($vars->{libmodperl} && -e $vars->{libmodperl}) {
|
||||
if (Apache::TestConfig::WIN32) {
|
||||
my $lib = "$Config{installbin}\\$Config{libperl}";
|
||||
$lib =~ s/lib$/dll/;
|
||||
$cfg = 'LoadFile ' . qq("$lib"\n) if -e $lib;
|
||||
}
|
||||
# add the module we found to the cached modules list
|
||||
# otherwise have_module('mod_perl') doesn't work unless
|
||||
# we have a LoadModule in our base config
|
||||
$self->{modules}->{'mod_perl.c'} = $vars->{libmodperl};
|
||||
|
||||
$cfg .= 'LoadModule ' . qq(perl_module "$vars->{libmodperl}"\n);
|
||||
}
|
||||
else {
|
||||
my $msg = "unable to locate $libname (could be a static build)\n";
|
||||
$cfg = "#$msg";
|
||||
debug $msg;
|
||||
}
|
||||
|
||||
$self->preamble(IfModule => '!mod_perl.c', $cfg);
|
||||
|
||||
}
|
||||
|
||||
sub configure_inc {
|
||||
my $self = shift;
|
||||
|
||||
my $top = $self->{vars}->{top_dir};
|
||||
|
||||
my $inc = $self->{inc};
|
||||
|
||||
for (catdir($top, qw(blib lib)), catdir($top, qw(blib arch))) {
|
||||
if (-d $_) {
|
||||
push @$inc, $_;
|
||||
}
|
||||
}
|
||||
|
||||
# try ../blib as well for Apache::Reload & Co
|
||||
for (catdir($top, qw(.. blib lib)), catdir($top, qw(.. blib arch))) {
|
||||
push @$inc, $_ if -d $_;
|
||||
}
|
||||
|
||||
# spec: If PERL5LIB is defined, PERLLIB is not used.
|
||||
for (qw(PERL5LIB PERLLIB)) {
|
||||
next unless exists $ENV{$_};
|
||||
push @$inc, split /$Config{path_sep}/, $ENV{$_};
|
||||
last;
|
||||
}
|
||||
|
||||
# enable live testing of the Apache-Test dev modules if they are
|
||||
# located at the project's root dir
|
||||
my $apache_test_dev_dir = catfile($top, 'Apache-Test', 'lib');
|
||||
unshift @$inc, $apache_test_dev_dir if -d $apache_test_dev_dir;
|
||||
}
|
||||
|
||||
sub write_pm_test {
|
||||
my($self, $module, $sub, @base) = @_;
|
||||
|
||||
my $dir = catfile $self->{vars}->{t_dir}, @base;
|
||||
my $t = catfile $dir, "$sub.t";
|
||||
return if -e $t;
|
||||
|
||||
$self->gendir($dir);
|
||||
my $fh = $self->genfile($t);
|
||||
|
||||
my $path = Apache::TestRequest::module2path($module);
|
||||
|
||||
print $fh <<EOF;
|
||||
use Apache::TestRequest 'GET_BODY_ASSERT';
|
||||
print GET_BODY_ASSERT "/$path";
|
||||
EOF
|
||||
|
||||
close $fh or die "close $t: $!";
|
||||
}
|
||||
|
||||
# propogate PerlPassEnv settings to the server
|
||||
sub configure_env {
|
||||
my $self = shift;
|
||||
$self->preamble(IfModule => 'mod_perl.c',
|
||||
[ qw(PerlPassEnv APACHE_TEST_TRACE_LEVEL
|
||||
PerlPassEnv HARNESS_PERL_SWITCHES
|
||||
PerlPassEnv APACHE_TEST_NO_STICKY_PREFERENCES)
|
||||
]);
|
||||
}
|
||||
|
||||
sub startup_pl_code {
|
||||
my $self = shift;
|
||||
my $serverroot = $self->{vars}->{serverroot};
|
||||
|
||||
my $cover = <<'EOF';
|
||||
if (($ENV{HARNESS_PERL_SWITCHES}||'') =~ m/Devel::Cover/) {
|
||||
eval {
|
||||
# 0.48 is the first version of Devel::Cover that can
|
||||
# really generate mod_perl coverage statistics
|
||||
require Devel::Cover;
|
||||
Devel::Cover->VERSION(0.48);
|
||||
|
||||
# this ignores coverage data for some generated files
|
||||
Devel::Cover->import('+inc' => 't/response/',);
|
||||
|
||||
1;
|
||||
} or die "Devel::Cover error: $@";
|
||||
}
|
||||
EOF
|
||||
|
||||
return <<"EOF";
|
||||
BEGIN {
|
||||
use lib '$serverroot';
|
||||
for my \$file (qw(modperl_inc.pl modperl_extra.pl)) {
|
||||
eval { require "conf/\$file" } or
|
||||
die if grep { -e "\$_/conf/\$file" } \@INC;
|
||||
}
|
||||
|
||||
$cover
|
||||
}
|
||||
|
||||
1;
|
||||
EOF
|
||||
}
|
||||
|
||||
sub configure_startup_pl {
|
||||
my $self = shift;
|
||||
|
||||
#for 2.0 we could just use PerlSwitches -Mlib=...
|
||||
#but this will work for both 2.0 and 1.xx
|
||||
if (my $inc = $self->{inc}) {
|
||||
my $include_pl = catfile $self->{vars}->{t_conf}, 'modperl_inc.pl';
|
||||
my $fh = $self->genfile($include_pl);
|
||||
for (reverse @$inc) {
|
||||
next unless $_;
|
||||
print $fh "use lib '$_';\n";
|
||||
}
|
||||
my $tlib = catdir $self->{vars}->{t_dir}, 'lib';
|
||||
if (-d $tlib) {
|
||||
print $fh "use lib '$tlib';\n";
|
||||
}
|
||||
|
||||
# directory for temp packages which can change during testing
|
||||
# we use require here since a circular dependency exists
|
||||
# between Apache::TestUtil and Apache::TestConfigPerl, so
|
||||
# use does not work here
|
||||
eval { require Apache::TestUtil; };
|
||||
if ($@) {
|
||||
die "could not require Apache::TestUtil: $@";
|
||||
} else {
|
||||
print $fh "use lib '" . Apache::TestUtil::_temp_package_dir() . "';\n";
|
||||
}
|
||||
|
||||
# if Apache::Test is used to develop a project, we want the
|
||||
# project/lib directory to be first in @INC (loaded last)
|
||||
if ($ENV{APACHE_TEST_LIVE_DEV}) {
|
||||
my $dev_lib = catdir $self->{vars}->{top_dir}, "lib";
|
||||
print $fh "use lib '$dev_lib';\n" if -d $dev_lib;
|
||||
}
|
||||
|
||||
print $fh "1;\n";
|
||||
}
|
||||
|
||||
if ($self->server->{rev} >= 2) {
|
||||
$self->postamble(IfModule => 'mod_perl.c',
|
||||
"PerlSwitches -Mlib=$self->{vars}->{serverroot}\n");
|
||||
}
|
||||
|
||||
my $startup_pl = catfile $self->{vars}->{t_conf}, 'modperl_startup.pl';
|
||||
|
||||
unless (-e $startup_pl) {
|
||||
my $fh = $self->genfile($startup_pl);
|
||||
print $fh $self->startup_pl_code;
|
||||
close $fh;
|
||||
}
|
||||
|
||||
$self->postamble(IfModule => 'mod_perl.c',
|
||||
"PerlRequire $startup_pl\n");
|
||||
}
|
||||
|
||||
my %sethandler_modperl = (1 => 'perl-script', 2 => 'modperl');
|
||||
|
||||
sub set_handler {
|
||||
my($self, $module, $args) = @_;
|
||||
return if grep { $_ eq 'SetHandler' } @$args;
|
||||
|
||||
push @$args,
|
||||
SetHandler =>
|
||||
$self->server->version_of(\%sethandler_modperl);
|
||||
}
|
||||
|
||||
sub set_connection_handler {
|
||||
my($self, $module, $args) = @_;
|
||||
my $port = $self->new_vhost($module);
|
||||
my $vars = $self->{vars};
|
||||
$self->postamble(Listen => '0.0.0.0:' . $port);
|
||||
}
|
||||
|
||||
my %add_hook_config = (
|
||||
Response => \&set_handler,
|
||||
ProcessConnection => \&set_connection_handler,
|
||||
PreConnection => \&set_connection_handler,
|
||||
);
|
||||
|
||||
my %container_config = (
|
||||
ProcessConnection => \&vhost_container,
|
||||
PreConnection => \&vhost_container,
|
||||
);
|
||||
|
||||
sub location_container {
|
||||
my($self, $module) = @_;
|
||||
my $path = Apache::TestRequest::module2path($module);
|
||||
Location => "/$path";
|
||||
}
|
||||
|
||||
sub vhost_container {
|
||||
my($self, $module) = @_;
|
||||
my $port = $self->{vhosts}->{$module}->{port};
|
||||
my $namebased = $self->{vhosts}->{$module}->{namebased};
|
||||
|
||||
VirtualHost => ($namebased ? '*' : '_default_') . ":$port";
|
||||
}
|
||||
|
||||
sub new_vhost {
|
||||
my($self, $module, $namebased) = @_;
|
||||
my($port, $servername, $vhost);
|
||||
|
||||
unless ($namebased and exists $self->{vhosts}->{$module}) {
|
||||
$port = $self->server->select_next_port;
|
||||
$vhost = $self->{vhosts}->{$module} = {};
|
||||
|
||||
$vhost->{port} = $port;
|
||||
$vhost->{namebased} = $namebased ? 1 : 0;
|
||||
}
|
||||
else {
|
||||
$vhost = $self->{vhosts}->{$module};
|
||||
$port = $vhost->{port};
|
||||
# remember the already configured Listen/NameVirtualHost
|
||||
$vhost->{namebased}++;
|
||||
}
|
||||
|
||||
$servername = $self->{vars}->{servername};
|
||||
|
||||
$vhost->{servername} = $servername;
|
||||
$vhost->{name} = join ':', $servername, $port;
|
||||
$vhost->{hostport} = $self->hostport($vhost, $module);
|
||||
|
||||
$port;
|
||||
}
|
||||
|
||||
my %outside_container = map { $_, 1 } qw{
|
||||
Alias AliasMatch AddType
|
||||
PerlChildInitHandler PerlTransHandler PerlPostReadRequestHandler
|
||||
PerlSwitches PerlRequire PerlModule
|
||||
};
|
||||
|
||||
my %strip_tags = map { $_ => 1} qw(base noautoconfig);
|
||||
|
||||
#test .pm's can have configuration after the __DATA__ token
|
||||
sub add_module_config {
|
||||
my($self, $module, $args) = @_;
|
||||
my $fh = Symbol::gensym();
|
||||
open($fh, $module) or return;
|
||||
|
||||
while (<$fh>) {
|
||||
last if /^(__(DATA|END)__|\#if CONFIG_FOR_HTTPD_TEST)/;
|
||||
}
|
||||
|
||||
my %directives;
|
||||
|
||||
while (<$fh>) {
|
||||
last if /^\#endif/; #for .c modules
|
||||
next unless /\S+/;
|
||||
chomp;
|
||||
s/^\s+//;
|
||||
$self->replace;
|
||||
if (/^#/) {
|
||||
# preserve comments
|
||||
$self->postamble($_);
|
||||
next;
|
||||
}
|
||||
my($directive, $rest) = split /\s+/, $_, 2;
|
||||
$directives{$directive}++ unless $directive =~ /^</;
|
||||
$rest = '' unless defined $rest;
|
||||
|
||||
if ($outside_container{$directive}) {
|
||||
$self->postamble($directive => $rest);
|
||||
}
|
||||
elsif ($directive =~ /IfModule/) {
|
||||
$self->postamble($_);
|
||||
}
|
||||
elsif ($directive =~ m/^<(\w+)/) {
|
||||
# strip special container directives like <Base> and </Base>
|
||||
my $strip_container = exists $strip_tags{lc $1} ? 1 : 0;
|
||||
|
||||
$directives{noautoconfig}++ if lc($1) eq 'noautoconfig';
|
||||
|
||||
my $indent = '';
|
||||
$self->process_container($_, $fh, lc($1),
|
||||
$strip_container, $indent);
|
||||
}
|
||||
else {
|
||||
push @$args, $directive, $rest;
|
||||
}
|
||||
}
|
||||
|
||||
\%directives;
|
||||
}
|
||||
|
||||
|
||||
# recursively process the directives including nested containers,
|
||||
# re-indent 4 and ucfirst the closing tags letter
|
||||
sub process_container {
|
||||
my($self, $first_line, $fh, $directive, $strip_container, $indent) = @_;
|
||||
|
||||
my $new_indent = $indent;
|
||||
|
||||
unless ($strip_container) {
|
||||
$new_indent .= " ";
|
||||
|
||||
local $_ = $first_line;
|
||||
s/^\s*//;
|
||||
$self->replace;
|
||||
|
||||
if (/<VirtualHost/) {
|
||||
$self->process_vhost_open_tag($_, $indent);
|
||||
}
|
||||
else {
|
||||
$self->postamble($indent . $_);
|
||||
}
|
||||
}
|
||||
|
||||
$self->process_container_remainder($fh, $directive, $new_indent);
|
||||
|
||||
unless ($strip_container) {
|
||||
$self->postamble($indent . "</\u$directive>");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
# processes the body of the container without the last line, including
|
||||
# the end tag
|
||||
sub process_container_remainder {
|
||||
my($self, $fh, $directive, $indent) = @_;
|
||||
|
||||
my $end_tag = "</$directive>";
|
||||
|
||||
while (<$fh>) {
|
||||
chomp;
|
||||
last if m|^\s*\Q$end_tag|i;
|
||||
s/^\s*//;
|
||||
$self->replace;
|
||||
|
||||
if (m/^\s*<(\w+)/) {
|
||||
$self->process_container($_, $fh, $1, 0, $indent);
|
||||
}
|
||||
else {
|
||||
$self->postamble($indent . $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# does the necessary processing to create a vhost container header
|
||||
sub process_vhost_open_tag {
|
||||
my($self, $line, $indent) = @_;
|
||||
|
||||
my $cfg = $self->parse_vhost($line);
|
||||
|
||||
if ($cfg) {
|
||||
my $port = $cfg->{port};
|
||||
$cfg->{out_postamble}->();
|
||||
$self->postamble($cfg->{line});
|
||||
$cfg->{in_postamble}->();
|
||||
} else {
|
||||
$self->postamble("$indent$line");
|
||||
}
|
||||
}
|
||||
|
||||
#the idea for each group:
|
||||
# Response: there will be many of these, mostly modules to test the API
|
||||
# that plan tests => ... and output with ok()
|
||||
# the naming allows grouping, making it easier to run an
|
||||
# individual set of tests, e.g. t/TEST t/apr
|
||||
# the PerlResponseHandler and SetHandler modperl is auto-configured
|
||||
# Hooks: for testing the simpler Perl*Handlers
|
||||
# auto-generates the Perl*Handler config
|
||||
# Protocol: protocol modules need their own port/vhost to listen on
|
||||
|
||||
#@INC is auto-modified so each test .pm can be found
|
||||
#modules can add their own configuration using __DATA__
|
||||
|
||||
my %hooks = map { $_, ucfirst $_ }
|
||||
qw(init trans headerparser access authen authz type fixup log);
|
||||
$hooks{Protocol} = 'ProcessConnection';
|
||||
$hooks{Filter} = 'OutputFilter';
|
||||
|
||||
my @extra_subdirs = qw(Response Protocol PreConnection Hooks Filter);
|
||||
|
||||
# add the subdirs to @INC early, in case mod_perl is started earlier
|
||||
sub configure_pm_tests_inc {
|
||||
my $self = shift;
|
||||
for my $subdir (@extra_subdirs) {
|
||||
my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
|
||||
next unless -d $dir;
|
||||
|
||||
push @{ $self->{inc} }, $dir;
|
||||
}
|
||||
}
|
||||
|
||||
# @status fields
|
||||
use constant APACHE_TEST_CONFIGURE => 0;
|
||||
use constant APACHE_TEST_CONFIG_ORDER => 1;
|
||||
|
||||
sub configure_pm_tests_pick {
|
||||
my($self, $entries) = @_;
|
||||
|
||||
for my $subdir (@extra_subdirs) {
|
||||
my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
|
||||
next unless -d $dir;
|
||||
|
||||
finddepth(sub {
|
||||
return unless /\.pm$/;
|
||||
|
||||
my $file = catfile $File::Find::dir, $_;
|
||||
my $module = abs2rel $file, $dir;
|
||||
my $status = $self->run_apache_test_config_scan($file);
|
||||
push @$entries, [$file, $module, $subdir, $status];
|
||||
}, $dir);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# a simple numerical order is performed and configuration sections are
|
||||
# inserted using that order. If the test package specifies no special
|
||||
# token that matches /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/ anywhere
|
||||
# in the file, 0 is assigned as its order. If the token is specified,
|
||||
# config section with negative values will be inserted first, with
|
||||
# positive last. By using different values you can arrange for the
|
||||
# test configuration sections to be inserted in any desired order
|
||||
sub configure_pm_tests_sort {
|
||||
my($self, $entries) = @_;
|
||||
|
||||
@$entries = sort {
|
||||
$a->[3]->[APACHE_TEST_CONFIG_ORDER] <=>
|
||||
$b->[3]->[APACHE_TEST_CONFIG_ORDER]
|
||||
} @$entries;
|
||||
|
||||
}
|
||||
|
||||
sub configure_pm_tests {
|
||||
my $self = shift;
|
||||
|
||||
my @entries = ();
|
||||
$self->configure_pm_tests_pick(\@entries);
|
||||
$self->configure_pm_tests_sort(\@entries);
|
||||
|
||||
for my $entry (@entries) {
|
||||
my ($file, $module, $subdir, $status) = @$entry;
|
||||
my @args = ();
|
||||
|
||||
my $file_display;
|
||||
{
|
||||
$file_display=$file;
|
||||
my $topdir=$self->{vars}->{top_dir};
|
||||
$file_display=~s!^\Q$topdir\E(.)(?:\1)*!!;
|
||||
}
|
||||
$self->postamble("\n# included from $file_display");
|
||||
my $directives = $self->add_module_config($file, \@args);
|
||||
$module =~ s,\.pm$,,;
|
||||
$module =~ s/^[a-z]://i; #strip drive if any
|
||||
$module = join '::', splitdir $module;
|
||||
|
||||
$self->run_apache_test_configure($file, $module, $status);
|
||||
|
||||
my @base =
|
||||
map { s/^test//i; $_ } split '::', $module;
|
||||
|
||||
my $sub = pop @base;
|
||||
|
||||
my $hook = ($subdir eq 'Hooks' ? $hooks{$sub} : '')
|
||||
|| $hooks{$subdir} || $subdir;
|
||||
|
||||
if ($hook eq 'OutputFilter' and $module =~ /::i\w+$/) {
|
||||
#XXX: tmp hack
|
||||
$hook = 'InputFilter';
|
||||
}
|
||||
|
||||
my $handler = join $hook, qw(Perl Handler);
|
||||
|
||||
if ($self->server->{rev} < 2 and lc($hook) eq 'response') {
|
||||
$handler =~ s/response//i; #s/PerlResponseHandler/PerlHandler/
|
||||
}
|
||||
|
||||
debug "configuring $module";
|
||||
|
||||
unless ($directives->{noautoconfig}) {
|
||||
if (my $cv = $add_hook_config{$hook}) {
|
||||
$self->$cv($module, \@args);
|
||||
}
|
||||
|
||||
my $container = $container_config{$hook} || \&location_container;
|
||||
|
||||
#unless the .pm test already configured the Perl*Handler
|
||||
unless ($directives->{$handler}) {
|
||||
my @handler_cfg = ($handler => $module);
|
||||
|
||||
if ($outside_container{$handler}) {
|
||||
my $cfg = $self->massage_config_args(@handler_cfg);
|
||||
$self->postamble(IfModule => 'mod_perl.c', $cfg);
|
||||
} else {
|
||||
push @args, @handler_cfg;
|
||||
}
|
||||
}
|
||||
|
||||
if (@args) {
|
||||
my $cfg = $self->massage_config_args($self->$container($module), \@args);
|
||||
$self->postamble(IfModule => 'mod_perl.c', $cfg);
|
||||
}
|
||||
}
|
||||
$self->postamble("# end of $file_display\n");
|
||||
|
||||
$self->write_pm_test($module, lc $sub, map { lc } @base);
|
||||
}
|
||||
}
|
||||
|
||||
# scan tests for interesting information
|
||||
sub run_apache_test_config_scan {
|
||||
my ($self, $file) = @_;
|
||||
|
||||
my @status = ();
|
||||
$status[APACHE_TEST_CONFIGURE] = 0;
|
||||
$status[APACHE_TEST_CONFIG_ORDER] = 0;
|
||||
|
||||
my $fh = Symbol::gensym();
|
||||
if (open $fh, $file) {
|
||||
local $/;
|
||||
my $content = <$fh>;
|
||||
close $fh;
|
||||
# XXX: optimize to match once?
|
||||
if ($content =~ /APACHE_TEST_CONFIGURE/m) {
|
||||
$status[APACHE_TEST_CONFIGURE] = 1;
|
||||
}
|
||||
if ($content =~ /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/m) {
|
||||
$status[APACHE_TEST_CONFIG_ORDER] = int $1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
error "cannot open $file: $!";
|
||||
}
|
||||
|
||||
return \@status;
|
||||
}
|
||||
|
||||
# We have to test whether tests have APACHE_TEST_CONFIGURE() in them
|
||||
# and run it if found at this stage, so when the server starts
|
||||
# everything is ready.
|
||||
# XXX: however we cannot use a simple require() because some tests
|
||||
# won't require() outside of mod_perl environment. Therefore we scan
|
||||
# the slurped file in. and if APACHE_TEST_CONFIGURE has been found we
|
||||
# require the file and run this function.
|
||||
sub run_apache_test_configure {
|
||||
my ($self, $file, $module, $status) = @_;
|
||||
|
||||
return unless $status->[APACHE_TEST_CONFIGURE];
|
||||
|
||||
eval { require $file };
|
||||
warn $@ if $@;
|
||||
# double check that it's a real sub
|
||||
if ($module->can('APACHE_TEST_CONFIGURE')) {
|
||||
eval { $module->APACHE_TEST_CONFIGURE($self); };
|
||||
warn $@ if $@;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue