← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy-updates

« back to all changes in this revision

Viewing changes to t/response/TestAPI/server_util.pm

  • Committer: Bazaar Package Importer
  • Author(s): Adam Conrad
  • Date: 2004-08-19 06:23:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040819062348-jxl4koqbtvgm8v2t
Tags: 1.99.14-4
Remove the LFS CFLAGS, and build-dep against apache2-*-dev (>= 2.0.50-10)
as we're backing out of the apache2/apr ABI transition.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/response/TestAPI/server_util.pm
5
5
 
6
6
use Apache::Test;
7
7
use Apache::TestUtil;
 
8
use File::Spec::Functions qw(canonpath catfile);
8
9
 
9
10
use Apache::RequestRec ();
10
11
use Apache::ServerUtil ();
 
12
use Apache::Process ();
 
13
 
 
14
use APR::Pool ();
11
15
 
12
16
use Apache::Const -compile => 'OK';
13
17
 
 
18
my $serverroot = Apache::Test::config()->{vars}->{serverroot};
 
19
 
 
20
our @ISA = qw(Apache::RequestRec);
 
21
 
 
22
sub new {
 
23
    my $class = shift;
 
24
    my $r = shift;
 
25
    bless { r => $r }, $class;
 
26
}
 
27
 
14
28
sub handler {
 
29
 
15
30
    my $r = shift;
16
31
 
17
 
    my $s = $r->server;
18
 
 
19
 
    plan $r, tests => 9;
20
 
 
21
 
    for my $p ($r->pool, $r->connection->pool,
22
 
               $r, $r->connection, $r->server)
23
 
    {
24
 
        my $dir = Apache::server_root_relative($p, 'conf');
25
 
 
26
 
        ok -d $dir;
27
 
    }
28
 
 
29
 
    my $dir = Apache::server_root; #constant
30
 
 
31
 
    ok -d $dir;
32
 
 
33
 
    $dir = join '/', Apache::server_root, 'logs';
34
 
 
35
 
    ok $dir eq Apache::server_root_relative($r->pool, 'logs');
36
 
 
37
 
    $dir = Apache->server_root_relative('logs'); #1.x ish
38
 
 
39
 
    ok -d $dir;
40
 
 
41
 
    #$r->server_root_relative works with use Apache::compat
42
 
    $dir = Apache->server_root_relative(); #1.x ish
43
 
 
44
 
    ok -d $dir;
 
32
    my %pools = ( 
 
33
        '$r->pool'                       => $r->pool, 
 
34
        '$r->connection->pool'           => $r->connection->pool,
 
35
        '$r->server->process->pool'      => $r->server->process->pool,
 
36
        '$r->server->process->pconf'     => $r->server->process->pconf,
 
37
        'Apache->server->process->pconf' => Apache->server->process->pconf,
 
38
        'APR::Pool->new'                 => APR::Pool->new,
 
39
    );
 
40
 
 
41
    my %objects = ( 
 
42
        '$r'                   => $r,
 
43
        '$r->connection'       => $r->connection,
 
44
        '$r->server'           => $r->server,
 
45
        '__PACKAGE__->new($r)' => __PACKAGE__->new($r),
 
46
    );
 
47
 
 
48
    my %status_lines = (
 
49
       200 => '200 OK',
 
50
       400 => '400 Bad Request',
 
51
       500 => '500 Internal Server Error',
 
52
    );
 
53
    plan $r, tests => (scalar keys %pools) +
 
54
                      (scalar keys %objects) + 
 
55
                      (scalar keys %status_lines) + 11;
 
56
 
 
57
    # syntax - an object or pool is required
 
58
    t_debug("Apache::server_root_relative() died");
 
59
    eval { my $dir = Apache::server_root_relative() };
 
60
    t_debug("\$\@: $@");
 
61
    ok $@;
 
62
 
 
63
    t_debug("Apache->server_root_relative() died");
 
64
    eval { my $dir = Apache->server_root_relative() };
 
65
    ok $@;
 
66
 
 
67
    # syntax - first argument must be an object, not a class
 
68
    t_debug("Apache->server_root_relative('conf') died");
 
69
    eval { my $dir = Apache->server_root_relative('conf') };
 
70
    ok $@;
 
71
 
 
72
    foreach my $p (keys %pools) {
 
73
 
 
74
        ok t_cmp(catfile($serverroot, 'conf'),
 
75
                 canonpath(Apache::server_root_relative($pools{$p},
 
76
                     'conf')),
 
77
                 "Apache:::server_root_relative($p, 'conf')");
 
78
    }
 
79
 
 
80
    # dig out the pool from valid objects
 
81
    foreach my $obj (keys %objects) {
 
82
 
 
83
        ok t_cmp(catfile($serverroot, 'conf'),
 
84
                 canonpath($objects{$obj}->server_root_relative('conf')),
 
85
                 "$obj->server_root_relative('conf')");
 
86
    }
 
87
 
 
88
    # syntax - unrecognized objects don't segfault
 
89
    {
 
90
        my $obj = bless {}, 'Apache::Foo';
 
91
        eval { Apache::server_root_relative($obj, 'conf') };
 
92
 
 
93
        ok t_cmp(qr/server_root_relative.*no .* key/,
 
94
                 $@,
 
95
                 "Apache::server_root_relative(\$obj, 'conf')");
 
96
    }
 
97
 
 
98
    # no file argument gives ServerRoot
 
99
    ok t_cmp(canonpath($serverroot),
 
100
             canonpath($r->server_root_relative),
 
101
             '$r->server_root_relative()');
 
102
 
 
103
    ok t_cmp(canonpath($serverroot),
 
104
             canonpath(Apache::server_root_relative($r->pool)),
 
105
             'Apache::server_root_relative($r->pool)');
 
106
 
 
107
    # Apache::server_root is also the ServerRoot constant
 
108
    ok t_cmp(canonpath(Apache::server_root),
 
109
             canonpath($r->server_root_relative),
 
110
             'Apache::server_root');
 
111
 
 
112
    {
 
113
        # absolute paths should resolve to themselves
 
114
        my $dir = $r->server_root_relative('logs');
 
115
 
 
116
        ok t_cmp($r->server_root_relative($dir),
 
117
                 $dir,
 
118
                 "\$r->server_root_relative($dir)");
 
119
    }
 
120
 
 
121
    t_debug('registering method FOO');
 
122
    ok Apache::method_register($r->server->process->pconf, 'FOO');
 
123
 
 
124
    t_debug('Apache::exists_config_define');
 
125
    ok Apache::exists_config_define('MODPERL2');
 
126
    ok ! Apache::exists_config_define('FOO');
 
127
 
 
128
    while (my($code, $line) = each %status_lines) {
 
129
        ok t_cmp($line,
 
130
                 Apache::get_status_line($code),
 
131
                 "Apache::get_status_line($code)");
 
132
    }
45
133
 
46
134
    Apache::OK;
47
135
}