| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Apache::Voodoo::Engine; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
$VERSION = "3.0200"; |
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
1166
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
29
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
25
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
6690
|
use DBI; |
|
|
1
|
|
|
|
|
21319
|
|
|
|
1
|
|
|
|
|
75
|
|
|
9
|
1
|
|
|
1
|
|
13
|
use File::Spec; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
23
|
|
|
10
|
1
|
|
|
1
|
|
2295
|
use Time::HiRes; |
|
|
1
|
|
|
|
|
2307
|
|
|
|
1
|
|
|
|
|
5
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
130
|
use Scalar::Util 'blessed'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
66
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
650
|
use Apache::Voodoo::Constants; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
27
|
|
|
15
|
1
|
|
|
1
|
|
509
|
use Apache::Voodoo::Application; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
40
|
|
|
16
|
1
|
|
|
1
|
|
7
|
use Apache::Voodoo::Exception; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
21
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
6
|
use Exception::Class::DBI; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
3553
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Debugging object. I don't like using an 'our' variable, but it is just too much |
|
21
|
|
|
|
|
|
|
# of a pain to pass this thing around to everywhere it needs to go. So, I just tell |
|
22
|
|
|
|
|
|
|
# myself that this is STDERR on god's own steroids so I can sleep at night. |
|
23
|
|
|
|
|
|
|
our $debug; |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $i_am_a_singleton; |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
|
28
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
|
29
|
0
|
|
|
|
|
|
my %opts = @_; |
|
30
|
|
|
|
|
|
|
|
|
31
|
0
|
0
|
|
|
|
|
if (ref($i_am_a_singleton)) { |
|
32
|
0
|
|
|
|
|
|
return $i_am_a_singleton; |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
my $self = {}; |
|
36
|
0
|
|
|
|
|
|
bless $self, $class; |
|
37
|
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
$self->{'mp'} = $opts{'mp'}; |
|
39
|
|
|
|
|
|
|
|
|
40
|
0
|
|
0
|
|
|
|
$self->{'constants'} = $opts{'constants'} || Apache::Voodoo::Constants->new(); |
|
41
|
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
|
$self->restart($opts{'only_start'}); |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Setup signal handler for die so that all deaths become exception objects |
|
45
|
|
|
|
|
|
|
# This way we can get a stack trace from where the death occurred, not where it was caught. |
|
46
|
|
|
|
|
|
|
$SIG{__DIE__} = sub { |
|
47
|
0
|
0
|
0
|
0
|
|
|
if (blessed($_[0]) && $_[0]->can("rethrow")) { |
|
48
|
|
|
|
|
|
|
# Already died using an exception class, just pass it up the chain |
|
49
|
0
|
|
|
|
|
|
$_[0]->rethrow; |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
else { |
|
52
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::RunTime->throw(error => join("\n", @_)); |
|
53
|
|
|
|
|
|
|
} |
|
54
|
0
|
|
|
|
|
|
}; |
|
55
|
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
$i_am_a_singleton = $self; |
|
57
|
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
return $self; |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub valid_app { |
|
62
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
63
|
0
|
|
|
|
|
|
my $app_id = shift; |
|
64
|
|
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
|
return (defined($self->{'apps'}->{$app_id}))?1:0; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub get_apps { |
|
69
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
70
|
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
return keys %{$self->{'apps'}}; |
|
|
0
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub is_devel_mode { |
|
75
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
76
|
0
|
0
|
|
|
|
|
return ($self->_app->config->{'devel_mode'})?1:0; |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub set_request { |
|
80
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
81
|
0
|
|
|
|
|
|
$self->{'mp'}->set_request(shift); |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub init_app { |
|
85
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
86
|
|
|
|
|
|
|
|
|
87
|
0
|
|
0
|
|
|
|
my $id = shift || $self->{'mp'}->get_app_id(); |
|
88
|
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
$self->{'app_id'} = $id; |
|
90
|
|
|
|
|
|
|
|
|
91
|
0
|
0
|
|
|
|
|
unless (defined($id)) { |
|
92
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::Application->throw( |
|
93
|
|
|
|
|
|
|
"PerlSetVar ID not present in configuration. Giving up." |
|
94
|
|
|
|
|
|
|
); |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# app exists? |
|
98
|
0
|
0
|
|
|
|
|
unless ($self->valid_app($id)) { |
|
99
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::Application->throw( |
|
100
|
|
|
|
|
|
|
"Application id '$id' unknown. Valid ids are: ".join(",",$self->get_apps()) |
|
101
|
|
|
|
|
|
|
); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
|
|
104
|
0
|
0
|
|
|
|
|
if ($self->_app->{'dynamic_loading'}) { |
|
105
|
0
|
|
|
|
|
|
$self->_app->refresh(); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
|
|
108
|
0
|
0
|
|
|
|
|
if ($self->_app->{'DEAD'}) { |
|
109
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::Application->throw("Application $id failed to load."); |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
return 1; |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub begin_run { |
|
117
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
118
|
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
$self->{'mp'}->register_cleanup($self,\&finish); |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# setup debugging |
|
122
|
0
|
|
|
|
|
|
$debug = $self->_app->{'debug_handler'}; |
|
123
|
0
|
|
|
|
|
|
$debug->init($self->{'mp'}); |
|
124
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"START"); |
|
125
|
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
$self->{'dbh'} = $self->attach_db(); |
|
127
|
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
$self->{'session_handler'} = $self->attach_session(); |
|
129
|
0
|
|
|
|
|
|
$self->{'session'} = $self->{'session_handler'}->session; |
|
130
|
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
$debug->session_id($self->{'session_handler'}->{'id'}); |
|
132
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,'Session Attachment'); |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,'DB Connect'); |
|
136
|
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
return 1; |
|
138
|
|
|
|
|
|
|
} |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub attach_db { |
|
141
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
142
|
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
my $db = undef; |
|
144
|
0
|
|
|
|
|
|
foreach (@{$self->_app->databases}) { |
|
|
0
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
eval { |
|
146
|
0
|
|
|
|
|
|
$db = DBI->connect_cached(@{$_}); |
|
|
0
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
}; |
|
148
|
0
|
0
|
|
|
|
|
last if $db; |
|
149
|
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::DBIConnect->throw($DBI::errstr); |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
return $db; |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub parse_params { |
|
157
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
158
|
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
my $params = $self->{mp}->parse_params($self->_app->config->{'upload_size_max'}); |
|
160
|
0
|
0
|
|
|
|
|
unless (ref($params)) { |
|
161
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::ParamParse->throw($params); |
|
162
|
|
|
|
|
|
|
} |
|
163
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"Parameter parsing"); |
|
164
|
0
|
|
|
|
|
|
$debug->params($params); |
|
165
|
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
return $params; |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub status { |
|
170
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
171
|
0
|
|
|
|
|
|
my $status = shift; |
|
172
|
|
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
|
if (defined($debug)) { |
|
174
|
0
|
|
|
|
|
|
$debug->status($status); |
|
175
|
0
|
|
|
|
|
|
$debug->session($self->{'session'}); |
|
176
|
|
|
|
|
|
|
} |
|
177
|
|
|
|
|
|
|
|
|
178
|
0
|
0
|
0
|
|
|
|
if (defined($self->_app) && defined($self->{'session_handler'})) { |
|
179
|
0
|
0
|
|
|
|
|
if ($self->{'p'}->{'uri'} =~ /\/?logout(_[^\/]+)?$/) { |
|
180
|
0
|
|
|
|
|
|
$self->{'mp'}->set_cookie($self->_app->config->{'cookie_name'},'!','now'); |
|
181
|
0
|
|
|
|
|
|
$self->{'session_handler'}->destroy(); |
|
182
|
|
|
|
|
|
|
} |
|
183
|
|
|
|
|
|
|
else { |
|
184
|
0
|
|
|
|
|
|
$self->{'session_handler'}->disconnect(); |
|
185
|
|
|
|
|
|
|
} |
|
186
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,'Session detachment'); |
|
187
|
|
|
|
|
|
|
} |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub finish { |
|
191
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
192
|
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,'Cleaning up.'); |
|
194
|
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
delete $self->{'app_id'}; |
|
196
|
0
|
|
|
|
|
|
delete $self->{'session_handler'}; |
|
197
|
0
|
|
|
|
|
|
delete $self->{'session'}; |
|
198
|
0
|
|
|
|
|
|
delete $self->{'p'}; |
|
199
|
0
|
|
|
|
|
|
delete $self->{'dbh'}; |
|
200
|
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
|
if (defined($debug)) { |
|
202
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,'END'); |
|
203
|
0
|
|
|
|
|
|
$debug->shutdown(); |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
} |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub attach_session { |
|
208
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
209
|
|
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
my $conf = $self->_app->config; |
|
211
|
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
my $session_id = $self->{'mp'}->get_cookie($conf->{'cookie_name'}); |
|
213
|
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
my $session = $self->_app->{'session_handler'}->attach($session_id,$self->{'dbh'}); |
|
215
|
|
|
|
|
|
|
|
|
216
|
0
|
0
|
0
|
|
|
|
if (!defined($session_id) || $session->id() ne $session_id) { |
|
|
|
0
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# This is a new session, or there was an old cookie from a previous sesion, |
|
218
|
0
|
|
|
|
|
|
$self->{'mp'}->set_cookie($conf->{'cookie_name'},$session->id()); |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
elsif ($session->has_expired($conf->{'session_timeout'})) { |
|
221
|
|
|
|
|
|
|
# the session has expired |
|
222
|
0
|
|
|
|
|
|
$self->{'mp'}->set_cookie($conf->{'cookie_name'},'!','now'); |
|
223
|
0
|
|
|
|
|
|
$session->destroy; |
|
224
|
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::Application::SessionTimeout->throw( |
|
226
|
|
|
|
|
|
|
target => $self->_adjust_url("/timeout"), |
|
227
|
|
|
|
|
|
|
error => "Session has expired" |
|
228
|
|
|
|
|
|
|
); |
|
229
|
|
|
|
|
|
|
} |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# update the session timer |
|
232
|
0
|
|
|
|
|
|
$session->touch(); |
|
233
|
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
return $session; |
|
235
|
|
|
|
|
|
|
} |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub history_capture { |
|
238
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
239
|
0
|
|
|
|
|
|
my $uri = shift; |
|
240
|
0
|
|
|
|
|
|
my $params = shift; |
|
241
|
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
my $session = $self->{'session'}; |
|
243
|
|
|
|
|
|
|
|
|
244
|
0
|
0
|
|
|
|
|
$uri = "/".$uri if $uri !~ /^\//; |
|
245
|
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# don't put the login page in the referrer queue |
|
247
|
0
|
0
|
|
|
|
|
return if $uri eq "/login"; |
|
248
|
|
|
|
|
|
|
|
|
249
|
0
|
0
|
0
|
|
|
|
if (!defined($session->{'history'}) || |
|
250
|
|
|
|
|
|
|
$session->{'history'}->[0]->{'uri'} ne $uri) { |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# queue is empty or this is a new page |
|
253
|
0
|
|
|
|
|
|
unshift(@{$session->{'history'}}, {'uri' => $uri, 'params' => join("&",map { $_."=".$params->{$_} } keys %{$params})}); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
else { |
|
256
|
|
|
|
|
|
|
# re-entrant call to page, update the params |
|
257
|
0
|
|
|
|
|
|
$session->{'history'}->[0]->{'params'} = join("&",map { $_."=".$params->{$_} } keys %{$params}); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
} |
|
259
|
|
|
|
|
|
|
|
|
260
|
0
|
0
|
|
|
|
|
if (scalar(@{$session->{'history'}}) > 30) { |
|
|
0
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# keep the queue at 10 items |
|
262
|
0
|
|
|
|
|
|
pop @{$session->{'history'}}; |
|
|
0
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
} |
|
264
|
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"history capture"); |
|
266
|
|
|
|
|
|
|
} |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub get_model { |
|
269
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
270
|
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
my $app_id = shift; |
|
272
|
0
|
|
|
|
|
|
my $model = shift; |
|
273
|
|
|
|
|
|
|
|
|
274
|
0
|
0
|
|
|
|
|
unless ($self->valid_app($app_id)) { |
|
275
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::Application->throw( |
|
276
|
|
|
|
|
|
|
"Application id '$app_id' unknown. Valid ids are: ".join(",",$self->get_apps()) |
|
277
|
|
|
|
|
|
|
); |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
|
return $self->{'apps'}->{$app_id}->{'models'}->{$model}; |
|
281
|
|
|
|
|
|
|
} |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub execute_controllers { |
|
284
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
285
|
0
|
|
|
|
|
|
my $uri = shift; |
|
286
|
0
|
|
|
|
|
|
my $params = shift; |
|
287
|
|
|
|
|
|
|
|
|
288
|
0
|
|
|
|
|
|
$uri =~ s/^\///; |
|
289
|
0
|
|
|
|
|
|
$debug->url($uri); |
|
290
|
|
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
my $app = $self->_app; |
|
292
|
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
my $template_conf = $app->resolve_conf_section($uri); |
|
294
|
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"config section resolution"); |
|
296
|
0
|
|
|
|
|
|
$debug->template_conf($template_conf); |
|
297
|
|
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
$self->{'p'} = { |
|
299
|
|
|
|
|
|
|
"dbh" => $self->{'dbh'}, |
|
300
|
|
|
|
|
|
|
"params" => $params, |
|
301
|
|
|
|
|
|
|
"session" => $self->{'session'}, |
|
302
|
|
|
|
|
|
|
"template_conf" => $template_conf, |
|
303
|
|
|
|
|
|
|
"mp" => $self->{'mp'}, |
|
304
|
|
|
|
|
|
|
"uri" => $uri, |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# these are deprecated. In the future get them from $p->{mp} or $p->{config} |
|
307
|
|
|
|
|
|
|
"document_root" => $self->_app->config->{'template_dir'}, |
|
308
|
|
|
|
|
|
|
"dir_config" => $self->{'mp'}->dir_config, |
|
309
|
|
|
|
|
|
|
"user-agent" => $self->{'mp'}->header_in('User-Agent'), |
|
310
|
|
|
|
|
|
|
"r" => $self->{'mp'}->{'r'}, |
|
311
|
|
|
|
|
|
|
"themes" => $self->_app->config->{'themes'} |
|
312
|
|
|
|
|
|
|
}; |
|
313
|
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
my $template_params; |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# call each of the pre_include modules followed by our page specific module followed by our post_includes |
|
317
|
0
|
|
0
|
|
|
|
foreach my $c ( |
|
|
0
|
|
0
|
|
|
|
|
|
318
|
0
|
|
|
|
|
|
( map { [ $_, "handle"] } split(/\s*,\s*/o, $template_conf->{'pre_include'} ||"") ), |
|
319
|
|
|
|
|
|
|
$app->map_uri($uri), |
|
320
|
|
|
|
|
|
|
( map { [ $_, "handle"] } split(/\s*,\s*/o, $template_conf->{'post_include'} ||"") ) |
|
321
|
|
|
|
|
|
|
) { |
|
322
|
|
|
|
|
|
|
|
|
323
|
0
|
0
|
0
|
|
|
|
if (defined($app->{'controllers'}->{$c->[0]}) && $app->{'controllers'}->{$c->[0]}->can($c->[1])) { |
|
324
|
0
|
|
|
|
|
|
my $obj = $app->{'controllers'}->{$c->[0]}; |
|
325
|
0
|
|
|
|
|
|
my $method = $c->[1]; |
|
326
|
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
my $return; |
|
328
|
0
|
|
|
|
|
|
eval { |
|
329
|
0
|
|
|
|
|
|
$return = $obj->$method($self->{'p'}); |
|
330
|
|
|
|
|
|
|
}; |
|
331
|
|
|
|
|
|
|
|
|
332
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"handler for ".$c->[0]." ".$c->[1]); |
|
333
|
0
|
|
|
|
|
|
$debug->return_data($c->[0],$c->[1],$return); |
|
334
|
|
|
|
|
|
|
|
|
335
|
0
|
0
|
|
|
|
|
if (my $e = Exception::Class->caught()) { |
|
336
|
0
|
0
|
|
|
|
|
if (ref($e) =~ /(AccessDenied|Redirect|DisplayError)$/) { |
|
|
|
0
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
|
$e->{'target'} = $self->_adjust_url($e->target); |
|
338
|
0
|
|
|
|
|
|
$e->rethrow(); |
|
339
|
|
|
|
|
|
|
} |
|
340
|
|
|
|
|
|
|
elsif (ref($e)) { |
|
341
|
0
|
|
|
|
|
|
$e->rethrow(); |
|
342
|
|
|
|
|
|
|
} |
|
343
|
|
|
|
|
|
|
else { |
|
344
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::RunTime->throw("$@"); |
|
345
|
|
|
|
|
|
|
} |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
0
|
0
|
0
|
|
|
|
if (!defined($template_params) || !ref($return)) { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# first overwrites empty, or scalar overwrites previous |
|
350
|
0
|
|
|
|
|
|
$template_params = $return; |
|
351
|
|
|
|
|
|
|
} |
|
352
|
|
|
|
|
|
|
elsif (ref($return) eq "HASH" && ref($template_params) eq "HASH") { |
|
353
|
|
|
|
|
|
|
# merge two hashes |
|
354
|
0
|
|
|
|
|
|
foreach my $k ( keys %{$return}) { |
|
|
0
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
|
$template_params->{$k} = $return->{$k}; |
|
356
|
|
|
|
|
|
|
} |
|
357
|
0
|
|
|
|
|
|
$debug->mark(Time::HiRes::time,"result packing"); |
|
358
|
|
|
|
|
|
|
} |
|
359
|
|
|
|
|
|
|
elsif (ref($return) eq "ARRAY" && ref($template_params) eq "ARRAY") { |
|
360
|
|
|
|
|
|
|
# merge two arrays |
|
361
|
0
|
|
|
|
|
|
push(@{$template_params},@{$return}); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
else { |
|
364
|
|
|
|
|
|
|
# eep. can't merge. |
|
365
|
0
|
|
|
|
|
|
Apache::Voodoo::Exception::RunTime::BadReturn->throw( |
|
366
|
|
|
|
|
|
|
module => $c->[0], |
|
367
|
|
|
|
|
|
|
method => $c->[1], |
|
368
|
|
|
|
|
|
|
data => $return |
|
369
|
|
|
|
|
|
|
); |
|
370
|
|
|
|
|
|
|
} |
|
371
|
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
|
last if $self->{'p'}->{'_stop_chain_'}; |
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
} |
|
375
|
|
|
|
|
|
|
|
|
376
|
0
|
|
|
|
|
|
return $template_params; |
|
377
|
|
|
|
|
|
|
} |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub execute_view { |
|
380
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
381
|
0
|
|
|
|
|
|
my $content = shift; |
|
382
|
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
|
my $view; |
|
384
|
0
|
0
|
0
|
|
|
|
if (defined($self->{'p'}->{'_view_'}) && |
|
|
|
0
|
0
|
|
|
|
|
|
385
|
|
|
|
|
|
|
defined($self->_app->{'views'}->{$self->{'p'}->{'_view_'}})) { |
|
386
|
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
$view = $self->_app->{'views'}->{$self->{'p'}->{'_view_'}}; |
|
388
|
|
|
|
|
|
|
} |
|
389
|
|
|
|
|
|
|
elsif (defined($self->{'p'}->{'template_conf'}->{'default_view'}) && |
|
390
|
|
|
|
|
|
|
defined($self->_app->{'views'}->{$self->{'p'}->{'template_conf'}->{'default_view'}})) { |
|
391
|
|
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
$view = $self->_app->{'views'}->{$self->{'p'}->{'template_conf'}->{'default_view'}}; |
|
393
|
|
|
|
|
|
|
} |
|
394
|
|
|
|
|
|
|
else { |
|
395
|
0
|
|
|
|
|
|
$view = $self->_app->{'views'}->{'HTML'}; |
|
396
|
|
|
|
|
|
|
} |
|
397
|
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
|
$view->begin($self->{'p'}); |
|
399
|
|
|
|
|
|
|
|
|
400
|
0
|
0
|
0
|
|
|
|
if (blessed($content) && $content->can('rethrow')) { |
|
401
|
0
|
|
|
|
|
|
$view->exception($content); |
|
402
|
|
|
|
|
|
|
} |
|
403
|
|
|
|
|
|
|
else { |
|
404
|
|
|
|
|
|
|
# pack up the params. note the presidence: module overrides template_conf |
|
405
|
0
|
|
|
|
|
|
$view->params($self->{'p'}->{'template_conf'}); |
|
406
|
0
|
|
|
|
|
|
$view->params($content); |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# add any params from the debugging handlers |
|
410
|
0
|
|
|
|
|
|
$view->params($debug->finalize()); |
|
411
|
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
|
return $view; |
|
413
|
|
|
|
|
|
|
} |
|
414
|
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub restart { |
|
416
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
417
|
0
|
|
|
|
|
|
my $app = shift; |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# wipe / initialize host information |
|
420
|
0
|
|
|
|
|
|
$self->{'apps'} = {}; |
|
421
|
|
|
|
|
|
|
|
|
422
|
0
|
|
|
|
|
|
warn "Voodoo starting...\n"; |
|
423
|
|
|
|
|
|
|
|
|
424
|
0
|
|
|
|
|
|
my $cf_name = $self->{'constants'}->conf_file(); |
|
425
|
0
|
|
|
|
|
|
my $install_path = $self->{'constants'}->install_path(); |
|
426
|
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
|
warn "Scanning: $install_path\n"; |
|
428
|
|
|
|
|
|
|
|
|
429
|
0
|
0
|
|
|
|
|
unless (opendir(DIR,$install_path)) { |
|
430
|
0
|
|
|
|
|
|
warn "Can't open dir: $!\n"; |
|
431
|
0
|
|
|
|
|
|
return; |
|
432
|
|
|
|
|
|
|
} |
|
433
|
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
foreach my $id (readdir(DIR)) { |
|
435
|
0
|
0
|
0
|
|
|
|
next if (defined($app) && $id ne $app); |
|
436
|
|
|
|
|
|
|
|
|
437
|
0
|
0
|
|
|
|
|
next unless $id =~ /^[a-z]\w*$/i; |
|
438
|
0
|
|
|
|
|
|
my $fp = File::Spec->catfile($install_path,$id,$cf_name); |
|
439
|
0
|
0
|
|
|
|
|
next unless -f $fp; |
|
440
|
0
|
0
|
|
|
|
|
next unless -r $fp; |
|
441
|
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
|
warn "starting application $id\n"; |
|
443
|
|
|
|
|
|
|
|
|
444
|
0
|
|
|
|
|
|
my $app = Apache::Voodoo::Application->new($id,$self->{'constants'}); |
|
445
|
|
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
|
my $dbh; |
|
447
|
|
|
|
|
|
|
# check to see if we can get a database connection |
|
448
|
0
|
|
|
|
|
|
foreach (@{$app->databases}) { |
|
|
0
|
|
|
|
|
|
|
|
449
|
0
|
|
|
|
|
|
eval { |
|
450
|
0
|
|
|
|
|
|
$dbh = DBI->connect(@{$_}); |
|
|
0
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
}; |
|
452
|
0
|
0
|
|
|
|
|
last if $dbh; |
|
453
|
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
warn "========================================================\n"; |
|
455
|
0
|
|
|
|
|
|
warn "DB CONNECT FAILED FOR $id\n"; |
|
456
|
0
|
|
|
|
|
|
warn $DBI::errstr."\n"; |
|
457
|
0
|
|
|
|
|
|
warn "========================================================\n"; |
|
458
|
|
|
|
|
|
|
} |
|
459
|
|
|
|
|
|
|
|
|
460
|
0
|
0
|
|
|
|
|
if ($dbh) { |
|
461
|
0
|
|
|
|
|
|
$dbh->disconnect; |
|
462
|
|
|
|
|
|
|
} |
|
463
|
|
|
|
|
|
|
|
|
464
|
0
|
|
|
|
|
|
$self->{'apps'}->{$id} = $app; |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# notifiy of start errors |
|
467
|
0
|
|
|
|
|
|
$self->{'apps'}->{$id}->{"DEAD"} = 0; |
|
468
|
|
|
|
|
|
|
|
|
469
|
0
|
0
|
|
|
|
|
if ($app->{'errors'}) { |
|
470
|
0
|
|
|
|
|
|
warn "$id has ".$app->{'errors'}." errors\n"; |
|
471
|
0
|
0
|
|
|
|
|
if ($app->{'halt_on_errors'}) { |
|
472
|
0
|
|
|
|
|
|
warn " (dropping this site)\n"; |
|
473
|
|
|
|
|
|
|
|
|
474
|
0
|
|
|
|
|
|
$self->{'apps'}->{$app->{'id'}}->{"DEAD"} = 1; |
|
475
|
|
|
|
|
|
|
|
|
476
|
0
|
|
|
|
|
|
return; |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
else { |
|
479
|
0
|
|
|
|
|
|
warn " (loading anyway)\n"; |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
} |
|
482
|
|
|
|
|
|
|
} |
|
483
|
0
|
|
|
|
|
|
closedir(DIR); |
|
484
|
|
|
|
|
|
|
|
|
485
|
0
|
|
|
|
|
|
foreach (values %{$self->{'apps'}}) { |
|
|
0
|
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
|
$_->bootstrapped(); |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub _adjust_url { |
|
491
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
492
|
0
|
|
|
|
|
|
my $uri = shift; |
|
493
|
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
my $sr = $self->{'mp'}->site_root(); |
|
495
|
0
|
0
|
0
|
|
|
|
if ($sr ne "/" && $uri =~ /^\//o) { |
|
496
|
0
|
|
|
|
|
|
return $sr.$uri; |
|
497
|
|
|
|
|
|
|
} |
|
498
|
|
|
|
|
|
|
else { |
|
499
|
0
|
|
|
|
|
|
return $uri; |
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
} |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub _app { |
|
505
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
506
|
|
|
|
|
|
|
|
|
507
|
0
|
|
|
|
|
|
return $self->{'apps'}->{$self->{'app_id'}}; |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
1; |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
################################################################################ |
|
514
|
|
|
|
|
|
|
# Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org). |
|
515
|
|
|
|
|
|
|
# All rights reserved. |
|
516
|
|
|
|
|
|
|
# |
|
517
|
|
|
|
|
|
|
# You may use and distribute Apache::Voodoo under the terms described in the |
|
518
|
|
|
|
|
|
|
# LICENSE file include in this package. The summary is it's a legalese version |
|
519
|
|
|
|
|
|
|
# of the Artistic License :) |
|
520
|
|
|
|
|
|
|
# |
|
521
|
|
|
|
|
|
|
################################################################################ |