1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
##########################################################
### this file contains code that should be run on the ###
### server startup but not during the config phase ###
##########################################################
use strict;
use warnings FATAL => 'all';
use Socket (); # test DynaLoader vs. XSLoader workaround for 5.6.x
use Apache2::ServerRec ();
use Apache2::ServerUtil ();
use Apache2::Process ();
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
use Apache2::Connection ();
use Apache2::Log ();
use APR::Table ();
use APR::Pool ();
use ModPerl::Util (); #for CORE::GLOBAL::exit
use Apache2::Const -compile => ':common';
END {
warn "END in modperl_extra.pl, pid=$$\n";
}
test_apache_resource();
test_apache_status();
test_loglevel();
test_perl_ithreads();
test_server_shutdown_cleanup_register();
test_method_obj();
### only subs below this line ###
sub test_apache_resource {
### Apache2::Resource tests
# load first for the menu
require Apache2::Status;
# uncomment for local tests
#$ENV{PERL_RLIMIT_DEFAULTS} = 1;
#$Apache2::Resource::Debug = 1;
# requires optional BSD::Resource
return unless eval { require BSD::Resource };
require Apache2::Resource;
}
sub test_apache_status {
### Apache2::Status tests
require Apache2::Status;
require Apache2::Module;
Apache2::Status->menu_item(
'test_menu' => "Test Menu Entry",
sub {
my ($r) = @_;
return ["This is just a test entry"];
}
) if Apache2::Module::loaded('Apache2::Status');
}
# test startup loglevel setting (under threaded mpms loglevel can be
# changed only before threads are started) so here we test whether we
# can still set it after restart
sub test_loglevel {
use Apache2::Const -compile => 'LOG_INFO';
my $s = Apache2::ServerUtil->server;
my $oldloglevel = $s->loglevel(Apache2::Const::LOG_INFO);
# restore
$s->loglevel($oldloglevel);
}
sub test_perl_ithreads {
# this is needed for TestPerl::ithreads
# one should be able to boot ithreads at the server startup and
# then access the ithreads setup at run-time when a perl
# interpreter is running on a different native threads (testing
# that perl interpreters and ithreads aren't related to the native
# threads they are running on). This should work starting from
# perl-5.8.1 and higher.
use Config;
if ($] >= 5.008001 && $Config{useithreads}) {
eval { require threads; "threads"->import() };
}
}
sub test_server_shutdown_cleanup_register {
Apache2::ServerUtil::server_shutdown_cleanup_register sub {
warn <<'EOF';
*** done with server_shutdown_cleanup_register ***
********************************************************************************
EOF
};
Apache2::ServerUtil::server_shutdown_cleanup_register sub {
die "testing server_shutdown_cleanup_register\n";
};
Apache2::ServerUtil::server_shutdown_cleanup_register sub {
warn <<'EOF';
********************************************************************************
*** This is a test for Apache2::ServerUtil::server_shutdown_cleanup_register ***
*** Following a line consisting only of * characters there should be a line ***
*** containing ***
*** "cleanup died: testing server_shutdown_cleanup_register". ***
*** The next line should then read ***
*** "done with server_shutdown_cleanup_register" ***
********************************************************************************
EOF
};
}
sub ModPerl::Test::exit_handler {
my ($p, $s) = @_;
$s->log->info("Child process pid=$$ is exiting");
Apache2::Const::OK;
}
sub test_method_obj {
# see t/modperl/methodobj
require TestModperl::methodobj;
$TestModperl::MethodObj = TestModperl::methodobj->new;
}
sub ModPerl::Test::add_config {
my $r = shift;
#test adding config at request time
$r->add_config(['require valid-user']);
Apache2::Const::OK;
}
1;
|
