line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Apache::Voodoo::Application; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
$VERSION = "3.0200"; |
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
1537
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
62
|
|
6
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
45
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
9
|
use Apache::Voodoo::Constants; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
40
|
|
9
|
2
|
|
|
2
|
|
1380
|
use Apache::Voodoo::Application::ConfigParser; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
96
|
|
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
1705
|
use Apache::Voodoo::Session; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
62
|
|
12
|
2
|
|
|
2
|
|
1286
|
use Apache::Voodoo::Debug; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
55
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
1177
|
use Data::Dumper; |
|
2
|
|
|
|
|
7573
|
|
|
2
|
|
|
|
|
2320
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new { |
17
|
4
|
|
|
4
|
0
|
6042
|
my $class = shift; |
18
|
4
|
|
|
|
|
10
|
my $self = {}; |
19
|
|
|
|
|
|
|
|
20
|
4
|
|
|
|
|
11
|
bless $self, $class; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# $self->{'debug'} = 1; |
23
|
|
|
|
|
|
|
|
24
|
4
|
|
|
|
|
12
|
$self->{'id'} = shift; |
25
|
4
|
|
66
|
|
|
26
|
$self->{'constants'} = shift || Apache::Voodoo::Constants->new(); |
26
|
|
|
|
|
|
|
|
27
|
4
|
100
|
|
|
|
30
|
die "ID is a required parameter." unless (defined($self->{'id'})); |
28
|
|
|
|
|
|
|
|
29
|
3
|
|
|
|
|
30
|
$self->{'parser'} = Apache::Voodoo::Application::ConfigParser->new($self->{'id'},$self->{'constants'}); |
30
|
3
|
|
|
|
|
11
|
$self->refresh(1); |
31
|
|
|
|
|
|
|
|
32
|
3
|
|
|
|
|
16
|
return $self; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub config { |
36
|
0
|
|
|
0
|
0
|
0
|
return $_[0]->{'parser'}->config(); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub databases { |
40
|
0
|
|
|
0
|
0
|
0
|
return $_[0]->{'parser'}->databases(); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub bootstrapped { |
44
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
0
|
$self->{debug_handler}->bootstrapped(); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub refresh { |
50
|
3
|
|
|
3
|
0
|
5
|
my $self = shift; |
51
|
3
|
|
|
|
|
6
|
my $initial = shift; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# If this is the initial load, or the config file has changed continue. |
54
|
3
|
50
|
33
|
|
|
12
|
unless ($initial || $self->{'parser'}->changed()) { |
55
|
0
|
|
|
|
|
0
|
return; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
3
|
|
|
|
|
8
|
my $config = $self->{'parser'}; |
59
|
|
|
|
|
|
|
|
60
|
3
|
|
|
|
|
4
|
my %old_m = %{$config->models()}; |
|
3
|
|
|
|
|
12
|
|
61
|
3
|
|
|
|
|
5
|
my %old_v = %{$config->views()}; |
|
3
|
|
|
|
|
14
|
|
62
|
3
|
|
|
|
|
5
|
my %old_c = %{$config->controllers()}; |
|
3
|
|
|
|
|
12
|
|
63
|
3
|
|
|
|
|
5
|
my %old_i = %{$config->includes()}; |
|
3
|
|
|
|
|
13
|
|
64
|
|
|
|
|
|
|
|
65
|
3
|
|
|
|
|
13
|
my $old_ns = $config->old_ns(); |
66
|
|
|
|
|
|
|
|
67
|
3
|
|
|
|
|
13
|
$config->parse(); |
68
|
|
|
|
|
|
|
|
69
|
3
|
|
|
|
|
15
|
$self->_reload_modules('m',\%old_m,$config->models()); |
70
|
3
|
|
|
|
|
15
|
$self->_reload_modules('v',\%old_v,$config->views()); |
71
|
|
|
|
|
|
|
|
72
|
3
|
50
|
33
|
|
|
14
|
if (defined($old_ns) && $old_ns != $config->old_ns()) { |
73
|
|
|
|
|
|
|
# They've swapped from the old style name for controller to the new syle |
74
|
|
|
|
|
|
|
# (or vice versa). Drop all the old controllers. |
75
|
|
|
|
|
|
|
|
76
|
0
|
|
|
|
|
0
|
$self->_debug("**Controller namespace has changed**"); |
77
|
0
|
|
|
|
|
0
|
foreach (keys %{$self->{'controllers'}}) { |
|
0
|
|
|
|
|
0
|
|
78
|
0
|
|
|
|
|
0
|
$self->_debug("Removing old module: $_"); |
79
|
0
|
|
|
|
|
0
|
delete $self->{'controllers'}->{$_}; |
80
|
|
|
|
|
|
|
} |
81
|
0
|
|
|
|
|
0
|
%old_c = (); |
82
|
0
|
|
|
|
|
0
|
%old_i = (); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# load the new includes |
86
|
3
|
|
|
|
|
15
|
$self->_reload_modules('c',\%old_i,$config->includes()); |
87
|
|
|
|
|
|
|
|
88
|
3
|
|
|
|
|
7
|
foreach (sort keys %{$config->controllers()}) { |
|
3
|
|
|
|
|
14
|
|
89
|
2
|
50
|
|
|
|
8
|
unless (exists($old_c{$_})) { |
90
|
|
|
|
|
|
|
# new module |
91
|
2
|
|
|
|
|
13
|
$self->_debug("Adding new module: $_"); |
92
|
2
|
|
|
|
|
9
|
$self->_prep_page_module($_); |
93
|
|
|
|
|
|
|
} |
94
|
2
|
|
|
|
|
6
|
delete $old_c{$_}; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
3
|
|
|
|
|
11
|
foreach (keys %old_c) { |
98
|
0
|
|
|
|
|
0
|
$self->_debug("Removing old module: $_"); |
99
|
0
|
|
|
|
|
0
|
delete $self->{'controllers'}->{$_}; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# If they didn't define their own HTML view, then we'll use our own; |
103
|
|
|
|
|
|
|
# this is a web server after all :) |
104
|
3
|
50
|
|
|
|
11
|
unless (defined($self->{'views'}->{'HTML'})) { |
105
|
3
|
|
|
|
|
703
|
require Apache::Voodoo::View::HTML; |
106
|
3
|
|
|
|
|
36
|
$self->{'views'}->{'HTML'} = Apache::Voodoo::View::HTML->new(); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Same idea for JSON. What website these days doesn't use even |
110
|
|
|
|
|
|
|
# a little AJAX? |
111
|
3
|
50
|
|
|
|
18
|
unless (defined($self->{'views'}->{'JSON'})) { |
112
|
3
|
|
|
|
|
970
|
require Apache::Voodoo::View::JSON; |
113
|
3
|
|
|
|
|
35
|
$self->{'views'}->{'JSON'} = Apache::Voodoo::View::JSON->new(); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# models get the config and every model except themselves |
117
|
|
|
|
|
|
|
# to prevent accidental circular references |
118
|
3
|
|
|
|
|
8
|
foreach my $key (keys %{$self->{'models'}}) { |
|
3
|
|
|
|
|
17
|
|
119
|
0
|
|
|
|
|
0
|
my %m = map { $_ => $self->{models}->{$_} } |
|
1
|
|
|
|
|
4
|
|
120
|
1
|
|
|
|
|
4
|
grep { $_ ne $key } |
121
|
1
|
|
|
|
|
3
|
keys %{$self->{'models'}}; |
122
|
|
|
|
|
|
|
|
123
|
1
|
|
|
|
|
3
|
eval { |
124
|
1
|
|
|
|
|
5
|
$self->{models}->{$key}->init($config->config(),\%m); |
125
|
|
|
|
|
|
|
}; |
126
|
1
|
50
|
|
|
|
7
|
if ($@) { |
127
|
0
|
|
|
|
|
0
|
warn "$@\n"; |
128
|
0
|
|
|
|
|
0
|
$self->{'errors'}++; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# views get just the config |
133
|
3
|
|
|
|
|
6
|
foreach (values %{$self->{'views'}}) { |
|
3
|
|
|
|
|
13
|
|
134
|
7
|
|
|
|
|
10
|
eval { |
135
|
7
|
|
|
|
|
29
|
$_->init($config->config()); |
136
|
|
|
|
|
|
|
}; |
137
|
7
|
50
|
|
|
|
159
|
if ($@) { |
138
|
0
|
|
|
|
|
0
|
warn "$@\n"; |
139
|
0
|
|
|
|
|
0
|
$self->{'errors'}++; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# controllers get the config and all the models |
144
|
3
|
|
|
|
|
10
|
foreach (values %{$self->{'controllers'}}) { |
|
3
|
|
|
|
|
16
|
|
145
|
3
|
|
|
|
|
5
|
eval { |
146
|
3
|
|
|
|
|
12
|
$_->init($config->config(),$self->{'models'}); |
147
|
|
|
|
|
|
|
}; |
148
|
3
|
50
|
|
|
|
19
|
if ($@) { |
149
|
0
|
|
|
|
|
0
|
warn "$@\n"; |
150
|
0
|
|
|
|
|
0
|
$self->{'errors'}++; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
3
|
|
|
|
|
6
|
eval { |
156
|
3
|
|
|
|
|
13
|
$self->{'session_handler'} = Apache::Voodoo::Session->new($config->config()); |
157
|
|
|
|
|
|
|
}; |
158
|
3
|
100
|
|
|
|
18
|
if ($@) { |
159
|
2
|
|
|
|
|
312
|
warn "$@\n"; |
160
|
2
|
|
|
|
|
12
|
$self->{'errors'}++; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
3
|
|
|
|
|
7
|
eval { |
164
|
3
|
|
|
|
|
17
|
$self->{'debug_handler'} = Apache::Voodoo::Debug->new($config->config()); |
165
|
|
|
|
|
|
|
}; |
166
|
3
|
50
|
|
|
|
23
|
if ($@) { |
167
|
0
|
|
|
|
|
0
|
warn "$@\n"; |
168
|
0
|
|
|
|
|
0
|
$self->{'errors'}++; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub map_uri { |
174
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
175
|
0
|
|
|
|
|
0
|
my $uri = shift; |
176
|
|
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
0
|
if (defined($self->{'controllers'}->{$uri})) { |
178
|
0
|
|
|
|
|
0
|
return [$uri,"handle"]; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
else { |
181
|
2
|
|
|
2
|
|
18
|
no warnings 'uninitialized'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
1891
|
|
182
|
0
|
|
|
|
|
0
|
my $p=''; |
183
|
0
|
|
|
|
|
0
|
my $m=''; |
184
|
0
|
|
|
|
|
0
|
my $o=''; |
185
|
0
|
|
|
|
|
0
|
($p,$m,$o) = ($uri =~ /^(.*?)([a-z]+)_(\w+)$/); |
186
|
0
|
|
|
|
|
0
|
return ["$p$o",$m]; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub resolve_conf_section { |
191
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
192
|
0
|
|
|
|
|
0
|
my $uri = shift; |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
0
|
my $template_conf = $self->{'parser'}->template_conf(); |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
0
|
if (exists($template_conf->{$uri})) { |
197
|
|
|
|
|
|
|
# one specific to this page |
198
|
0
|
|
|
|
|
0
|
return $template_conf->{$uri}; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
0
|
foreach (sort { length($b) <=> length($a) } keys %{$template_conf}) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
202
|
0
|
0
|
|
|
|
0
|
if ($uri =~ /^$_$/) { |
203
|
|
|
|
|
|
|
# match by uri regexp |
204
|
0
|
|
|
|
|
0
|
return $template_conf->{$_}; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# not one, return the default |
209
|
0
|
|
|
|
|
0
|
return $template_conf->{'default'}; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _reload_modules { |
213
|
9
|
|
|
9
|
|
13
|
my $self = shift; |
214
|
9
|
|
|
|
|
12
|
my $ns = shift; |
215
|
9
|
|
|
|
|
12
|
my $old = shift; |
216
|
9
|
|
|
|
|
14
|
my $new = shift; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# check the new list of modules against the old list |
219
|
9
|
|
|
|
|
42
|
foreach (sort keys %{$new}) { |
|
9
|
|
|
|
|
34
|
|
220
|
3
|
50
|
|
|
|
12
|
unless (exists($old->{$_})) { |
221
|
|
|
|
|
|
|
# new module (wasn't in the old list). |
222
|
3
|
|
|
|
|
18
|
$self->_debug("Adding new $ns module: $_"); |
223
|
3
|
|
|
|
|
12
|
$self->_prep_module($ns,$_); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# still a valid module, so remove it from this list. |
227
|
3
|
|
|
|
|
13
|
delete $old->{$_}; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# whatever is left in old are ones that weren't in the new list. |
231
|
9
|
|
|
|
|
19
|
foreach (keys %{$old}) { |
|
9
|
|
|
|
|
27
|
|
232
|
0
|
|
|
|
|
0
|
$self->_debug("Removing old module: $_"); |
233
|
0
|
|
|
|
|
0
|
$_ =~ s/::/\//g; |
234
|
0
|
|
|
|
|
0
|
delete $self->{'controllers'}->{$_}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub _prep_module { |
239
|
3
|
|
|
3
|
|
5
|
my $self = shift; |
240
|
3
|
|
|
|
|
5
|
my $ns = shift; |
241
|
3
|
|
|
|
|
7
|
my $module = shift; |
242
|
|
|
|
|
|
|
|
243
|
3
|
|
|
|
|
21
|
my $obj = $self->_load_module($ns,$module); |
244
|
|
|
|
|
|
|
|
245
|
3
|
100
|
|
|
|
18
|
$ns = ($ns eq "m")?"models": |
|
|
100
|
|
|
|
|
|
246
|
|
|
|
|
|
|
($ns eq "v")?"views":"controllers"; |
247
|
|
|
|
|
|
|
|
248
|
3
|
|
|
|
|
14
|
$self->{$ns}->{$module} = $obj; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub _prep_page_module { |
252
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
253
|
2
|
|
|
|
|
6
|
my $module = shift; |
254
|
|
|
|
|
|
|
|
255
|
2
|
|
|
|
|
7
|
my $obj = $self->_load_module('c',$module); |
256
|
2
|
|
|
|
|
7
|
$module =~ s/::/\//g; |
257
|
|
|
|
|
|
|
|
258
|
2
|
|
|
|
|
10
|
$self->{'controllers'}->{$module} = $obj; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub _load_module { |
262
|
5
|
|
|
5
|
|
11
|
my $self = shift; |
263
|
5
|
|
|
|
|
8
|
my $ns = shift; |
264
|
5
|
|
|
|
|
8
|
my $module = shift; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
267
|
5
|
100
|
100
|
|
|
57
|
unless ($ns eq "c" and $self->{'parser'}->old_ns()) { |
268
|
3
|
|
|
|
|
10
|
$module = uc($ns)."::".$module; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
5
|
|
|
|
|
25
|
$module = $self->{'parser'}->config()->{'base_package'}."::".$module; |
272
|
|
|
|
|
|
|
|
273
|
5
|
|
|
|
|
9
|
my $obj; |
274
|
5
|
50
|
|
|
|
19
|
if ($self->{'parser'}->config()->{'dynamic_loading'}) { |
275
|
5
|
|
|
|
|
1000
|
require Apache::Voodoo::Loader::Dynamic; |
276
|
|
|
|
|
|
|
|
277
|
5
|
|
|
|
|
39
|
$obj = Apache::Voodoo::Loader::Dynamic->new($module); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
else { |
280
|
0
|
|
|
|
|
0
|
require Apache::Voodoo::Loader::Static; |
281
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
$obj = Apache::Voodoo::Loader::Static->new($module); |
283
|
0
|
0
|
|
|
|
0
|
if (ref($obj) eq "Apache::Voodoo::Zombie") { |
284
|
|
|
|
|
|
|
# doh! the module went boom |
285
|
0
|
|
|
|
|
0
|
$self->{'errors'}++; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
5
|
|
|
|
|
17
|
return $obj; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub _debug { |
293
|
5
|
|
|
5
|
|
12
|
my $self = shift; |
294
|
|
|
|
|
|
|
|
295
|
5
|
50
|
|
|
|
20
|
return unless $self->{'debug'}; |
296
|
|
|
|
|
|
|
|
297
|
0
|
0
|
|
|
|
|
if (ref($_[0])) { |
298
|
0
|
|
|
|
|
|
warn Dumper(@_); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
else { |
301
|
0
|
|
|
|
|
|
warn join("\n",@_),"\n"; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
1; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
################################################################################ |
308
|
|
|
|
|
|
|
# Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org). |
309
|
|
|
|
|
|
|
# All rights reserved. |
310
|
|
|
|
|
|
|
# |
311
|
|
|
|
|
|
|
# You may use and distribute Apache::Voodoo under the terms described in the |
312
|
|
|
|
|
|
|
# LICENSE file include in this package. The summary is it's a legalese version |
313
|
|
|
|
|
|
|
# of the Artistic License :) |
314
|
|
|
|
|
|
|
# |
315
|
|
|
|
|
|
|
################################################################################ |