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
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestApache::conftree;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestConfig ();
use Apache2::Directive ();
use Apache2::Const -compile => 'OK';
sub handler {
my $r = shift;
my $cfg = Apache::Test::config();
my $node_count = node_count();
plan $r, tests => 8 + (5*$node_count);
ok $cfg;
my $vars = $cfg->{vars};
ok $vars;
my $tree = Apache2::Directive::conftree();
ok $tree;
my $hostname_lookups = $tree->lookup('HostnameLookups');
ok t_cmp($hostname_lookups, "Off");
my $documentroot = $tree->lookup('DocumentRoot');
ok t_cmp(ref($tree->as_hash()), 'HASH', 'as_hash');
ok t_cmp($documentroot, qq("$vars->{documentroot}"));
ok t_cmp($tree->lookup("DocumentRoot"), qq("$vars->{documentroot}"));
#XXX: This test isn't so good, but its quite problematic to try
#and _really_ compare $cfg and $tree...
{
my %vhosts = map {
$cfg->{vhosts}{$_}{name} => { %{$cfg->{vhosts}{$_}}, index => $_ }
} keys %{$cfg->{vhosts}};
for my $v (keys %vhosts) {
$vhosts{ $vhosts{$v}{index} } = $vhosts{$v};
}
my $vhost_failed;
for my $vhost ($tree->lookup("VirtualHost")) {
unless (exists $vhosts{$vhost->{'ServerName'}
|| $vhost->{'PerlProcessConnectionHandler'}}) {
$vhost_failed++;
}
}
ok !$vhost_failed;
}
traverse_tree ( \&test_node );
Apache2::Const::OK;
}
sub test_node {
my ($data, $node) = @_;
ok $node->directive;
#Args can be null for argless directives
ok $node->args || 1;
#As string can be null for containers
ok $node->as_string || 1;
ok $node->filename;
ok $node->line_num;
}
sub traverse_tree {
my ($sub, $data) = @_;
my $node = Apache2::Directive::conftree();
while ($node) {
$sub->($data, $node);
if (my $kid = $node->first_child) {
$node = $kid;
}
elsif (my $next = $node->next) {
$node = $next;
}
else {
if (my $parent = $node->parent) {
$node = $parent->next;
}
else {
$node = undef;
}
}
}
return;
}
sub node_count {
my $node_count = 0;
traverse_tree( sub { ${$_[0]}++ }, \$node_count );
return $node_count;
}
1;
|
