line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ABSTRACT: encapsulation of Dancer2 packages |
2
|
|
|
|
|
|
|
package Dancer2::Core::App; |
3
|
|
|
|
|
|
|
$Dancer2::Core::App::VERSION = '1.0.0'; |
4
|
145
|
|
|
145
|
|
299956
|
use Moo; |
|
145
|
|
|
|
|
851578
|
|
|
145
|
|
|
|
|
820
|
|
5
|
145
|
|
|
145
|
|
183078
|
use Carp qw<croak carp>; |
|
145
|
|
|
|
|
396
|
|
|
145
|
|
|
|
|
7410
|
|
6
|
145
|
|
|
145
|
|
899
|
use Scalar::Util 'blessed'; |
|
145
|
|
|
|
|
373
|
|
|
145
|
|
|
|
|
5944
|
|
7
|
145
|
|
|
145
|
|
2564
|
use Module::Runtime 'is_module_name'; |
|
145
|
|
|
|
|
5925
|
|
|
145
|
|
|
|
|
879
|
|
8
|
145
|
|
|
145
|
|
59992
|
use Safe::Isa; |
|
145
|
|
|
|
|
58517
|
|
|
145
|
|
|
|
|
20721
|
|
9
|
145
|
|
|
145
|
|
62673
|
use Sub::Quote; |
|
145
|
|
|
|
|
758781
|
|
|
145
|
|
|
|
|
9267
|
|
10
|
145
|
|
|
145
|
|
1123
|
use File::Spec; |
|
145
|
|
|
|
|
301
|
|
|
145
|
|
|
|
|
4324
|
|
11
|
145
|
|
|
145
|
|
810
|
use Module::Runtime qw< require_module use_module >; |
|
145
|
|
|
|
|
328
|
|
|
145
|
|
|
|
|
952
|
|
12
|
145
|
|
|
145
|
|
7331
|
use List::Util (); |
|
145
|
|
|
|
|
334
|
|
|
145
|
|
|
|
|
2913
|
|
13
|
145
|
|
|
145
|
|
45806
|
use Ref::Util qw< is_ref is_globref is_scalarref >; |
|
145
|
|
|
|
|
150525
|
|
|
145
|
|
|
|
|
9518
|
|
14
|
|
|
|
|
|
|
|
15
|
145
|
|
|
145
|
|
65239
|
use Plack::App::File; |
|
145
|
|
|
|
|
2430898
|
|
|
145
|
|
|
|
|
5988
|
|
16
|
145
|
|
|
145
|
|
63576
|
use Plack::Middleware::FixMissingBodyInRedirect; |
|
145
|
|
|
|
|
1113833
|
|
|
145
|
|
|
|
|
5989
|
|
17
|
145
|
|
|
145
|
|
59966
|
use Plack::Middleware::Head; |
|
145
|
|
|
|
|
38943
|
|
|
145
|
|
|
|
|
4762
|
|
18
|
145
|
|
|
145
|
|
58746
|
use Plack::Middleware::Conditional; |
|
145
|
|
|
|
|
36652
|
|
|
145
|
|
|
|
|
4726
|
|
19
|
145
|
|
|
145
|
|
60363
|
use Plack::Middleware::ConditionalGET; |
|
145
|
|
|
|
|
88140
|
|
|
145
|
|
|
|
|
5309
|
|
20
|
|
|
|
|
|
|
|
21
|
145
|
|
|
145
|
|
57334
|
use Dancer2::FileUtils 'path'; |
|
145
|
|
|
|
|
438
|
|
|
145
|
|
|
|
|
8897
|
|
22
|
145
|
|
|
145
|
|
2520
|
use Dancer2::Core; |
|
145
|
|
|
|
|
369
|
|
|
145
|
|
|
|
|
2804
|
|
23
|
145
|
|
|
145
|
|
60592
|
use Dancer2::Core::Cookie; |
|
145
|
|
|
|
|
596
|
|
|
145
|
|
|
|
|
6291
|
|
24
|
145
|
|
|
145
|
|
74107
|
use Dancer2::Core::Error; |
|
145
|
|
|
|
|
554
|
|
|
145
|
|
|
|
|
5650
|
|
25
|
145
|
|
|
145
|
|
1191
|
use Dancer2::Core::Types; |
|
145
|
|
|
|
|
355
|
|
|
145
|
|
|
|
|
1196
|
|
26
|
145
|
|
|
145
|
|
1799590
|
use Dancer2::Core::Route; |
|
145
|
|
|
|
|
517
|
|
|
145
|
|
|
|
|
5271
|
|
27
|
145
|
|
|
145
|
|
59660
|
use Dancer2::Core::Hook; |
|
145
|
|
|
|
|
520
|
|
|
145
|
|
|
|
|
4949
|
|
28
|
145
|
|
|
145
|
|
79535
|
use Dancer2::Core::Request; |
|
145
|
|
|
|
|
603
|
|
|
145
|
|
|
|
|
6534
|
|
29
|
145
|
|
|
145
|
|
60598
|
use Dancer2::Core::Factory; |
|
145
|
|
|
|
|
493
|
|
|
145
|
|
|
|
|
4460
|
|
30
|
|
|
|
|
|
|
|
31
|
145
|
|
|
145
|
|
63125
|
use Dancer2::Handler::File; |
|
145
|
|
|
|
|
619
|
|
|
145
|
|
|
|
|
1205962
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our $EVAL_SHIM; $EVAL_SHIM ||= sub { |
34
|
|
|
|
|
|
|
my $code = shift; |
35
|
|
|
|
|
|
|
$code->(@_); |
36
|
|
|
|
|
|
|
}; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# we have hooks here |
40
|
|
|
|
|
|
|
with qw< |
41
|
|
|
|
|
|
|
Dancer2::Core::Role::Hookable |
42
|
|
|
|
|
|
|
Dancer2::Core::Role::ConfigReader |
43
|
|
|
|
|
|
|
>; |
44
|
|
|
|
|
|
|
|
45
|
265
|
|
|
265
|
0
|
1979
|
sub supported_engines { [ qw<logger serializer session template> ] } |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub with_plugins { |
48
|
37
|
|
|
37
|
1
|
129
|
my ( $self, @plugins ) = @_; |
49
|
37
|
|
|
|
|
176
|
return map $self->_with_plugin($_), @plugins; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _with_plugin { |
54
|
37
|
|
|
37
|
|
146
|
my( $self, $plugin ) = @_; |
55
|
|
|
|
|
|
|
|
56
|
37
|
100
|
|
|
|
156
|
if ( is_ref($plugin) ) { |
57
|
|
|
|
|
|
|
# passing the plugin as an already-created object |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# already loaded? |
60
|
1
|
50
|
|
|
|
6
|
if( my ( $already ) = grep { ref($plugin) eq ref $_; } @{ $self->plugins } ) { |
|
2
|
|
|
|
|
19
|
|
|
1
|
|
|
|
|
19
|
|
61
|
0
|
0
|
|
|
|
0
|
die "trying to load two different objects for plugin ". ref $plugin |
62
|
|
|
|
|
|
|
if refaddr($plugin) != refaddr $already ; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else { |
66
|
1
|
|
|
|
|
2
|
push @{ $self->plugins }, $plugin; |
|
1
|
|
|
|
|
17
|
|
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
11
|
return $plugin; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# short plugin names get Dancer2::Plugin:: prefix |
73
|
|
|
|
|
|
|
# plugin names starting with a '+' are full package names |
74
|
36
|
100
|
|
|
|
227
|
if ( $plugin !~ s/^\+// ) { |
75
|
7
|
|
|
|
|
44
|
$plugin =~ s/^(?!Dancer2::Plugin::)/Dancer2::Plugin::/; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# check if it's already there |
79
|
36
|
100
|
|
|
|
108
|
if( my ( $already ) = grep { $plugin eq ref $_ } @{ $self->plugins } ) { |
|
12
|
|
|
|
|
141
|
|
|
36
|
|
|
|
|
772
|
|
80
|
2
|
|
|
|
|
10
|
return $already; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
34
|
|
|
|
|
409
|
push @{ $self->plugins }, |
|
34
|
|
|
|
|
557
|
|
84
|
|
|
|
|
|
|
$plugin = use_module($plugin)->new( app => $self ); |
85
|
|
|
|
|
|
|
|
86
|
34
|
|
|
|
|
570
|
return $plugin; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub with_plugin { |
90
|
37
|
|
|
37
|
1
|
8285
|
my( $self, $plugin ) = @_; |
91
|
|
|
|
|
|
|
|
92
|
37
|
50
|
|
|
|
144
|
croak "expected a single argument" |
93
|
|
|
|
|
|
|
unless @_ == 2; |
94
|
|
|
|
|
|
|
|
95
|
37
|
|
|
|
|
167
|
( $self->with_plugins($plugin) )[0]; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
has _factory => ( |
99
|
|
|
|
|
|
|
is => 'ro', |
100
|
|
|
|
|
|
|
isa => InstanceOf['Dancer2::Core::Factory'], |
101
|
|
|
|
|
|
|
lazy => 1, |
102
|
|
|
|
|
|
|
default => sub { Dancer2::Core::Factory->new }, |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
has logger_engine => ( |
106
|
|
|
|
|
|
|
is => 'ro', |
107
|
|
|
|
|
|
|
isa => ConsumerOf['Dancer2::Core::Role::Logger'], |
108
|
|
|
|
|
|
|
lazy => 1, |
109
|
|
|
|
|
|
|
builder => '_build_logger_engine', |
110
|
|
|
|
|
|
|
writer => 'set_logger_engine', |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
has session_engine => ( |
114
|
|
|
|
|
|
|
is => 'ro', |
115
|
|
|
|
|
|
|
isa => ConsumerOf['Dancer2::Core::Role::SessionFactory'], |
116
|
|
|
|
|
|
|
lazy => 1, |
117
|
|
|
|
|
|
|
builder => '_build_session_engine', |
118
|
|
|
|
|
|
|
writer => 'set_session_engine', |
119
|
|
|
|
|
|
|
); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
has template_engine => ( |
122
|
|
|
|
|
|
|
is => 'ro', |
123
|
|
|
|
|
|
|
isa => ConsumerOf['Dancer2::Core::Role::Template'], |
124
|
|
|
|
|
|
|
lazy => 1, |
125
|
|
|
|
|
|
|
builder => '_build_template_engine', |
126
|
|
|
|
|
|
|
writer => 'set_template_engine', |
127
|
|
|
|
|
|
|
); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
has serializer_engine => ( |
130
|
|
|
|
|
|
|
is => 'ro', |
131
|
|
|
|
|
|
|
isa => ConsumerOf['Dancer2::Core::Role::Serializer'], |
132
|
|
|
|
|
|
|
lazy => 1, |
133
|
|
|
|
|
|
|
builder => '_build_serializer_engine', |
134
|
|
|
|
|
|
|
writer => 'set_serializer_engine', |
135
|
|
|
|
|
|
|
predicate => 'has_serializer_engine', |
136
|
|
|
|
|
|
|
); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
has '+local_triggers' => ( |
139
|
|
|
|
|
|
|
default => sub { |
140
|
|
|
|
|
|
|
my $self = shift; |
141
|
|
|
|
|
|
|
my $triggers = { |
142
|
|
|
|
|
|
|
# general triggers we want to allow, besides engines |
143
|
|
|
|
|
|
|
views => sub { |
144
|
|
|
|
|
|
|
my $self = shift; |
145
|
|
|
|
|
|
|
my $value = shift; |
146
|
|
|
|
|
|
|
$self->template_engine->views($value); |
147
|
|
|
|
|
|
|
}, |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
layout => sub { |
150
|
|
|
|
|
|
|
my $self = shift; |
151
|
|
|
|
|
|
|
my $value = shift; |
152
|
|
|
|
|
|
|
$self->template_engine->layout($value); |
153
|
|
|
|
|
|
|
}, |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
layout_dir => sub { |
156
|
|
|
|
|
|
|
my $self = shift; |
157
|
|
|
|
|
|
|
my $value = shift; |
158
|
|
|
|
|
|
|
$self->template_engine->layout_dir($value); |
159
|
|
|
|
|
|
|
}, |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
log => sub { |
162
|
|
|
|
|
|
|
my ( $self, $value, $config ) = @_; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# This will allow to set the log level |
165
|
|
|
|
|
|
|
# using: set log => warning |
166
|
|
|
|
|
|
|
$self->logger_engine->log_level($value); |
167
|
|
|
|
|
|
|
}, |
168
|
|
|
|
|
|
|
}; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
foreach my $engine ( @{ $self->supported_engines } ) { |
171
|
|
|
|
|
|
|
$triggers->{$engine} = sub { |
172
|
|
|
|
|
|
|
my $self = shift; |
173
|
|
|
|
|
|
|
my $value = shift; |
174
|
|
|
|
|
|
|
my $config = shift; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
is_ref($value) and return $value; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my $build_method = "_build_${engine}_engine"; |
179
|
|
|
|
|
|
|
my $setter_method = "set_${engine}_engine"; |
180
|
|
|
|
|
|
|
my $engine_instance = $self->$build_method( $value, $config ); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# set the engine with the new value from the builder |
183
|
|
|
|
|
|
|
$self->$setter_method($engine_instance); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
return $engine_instance; |
186
|
|
|
|
|
|
|
}; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
return $triggers; |
190
|
|
|
|
|
|
|
}, |
191
|
|
|
|
|
|
|
); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub _build_logger_engine { |
194
|
254
|
|
|
254
|
|
5791
|
my $self = shift; |
195
|
254
|
|
|
|
|
597
|
my $value = shift; |
196
|
254
|
|
|
|
|
545
|
my $config = shift; |
197
|
|
|
|
|
|
|
|
198
|
254
|
100
|
|
|
|
5702
|
defined $config or $config = $self->config; |
199
|
254
|
100
|
|
|
|
3383
|
defined $value or $value = $config->{logger}; |
200
|
|
|
|
|
|
|
|
201
|
254
|
50
|
|
|
|
1676
|
is_ref($value) and return $value; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# XXX This is needed for the tests that create an app without |
204
|
|
|
|
|
|
|
# a runner. |
205
|
254
|
50
|
|
|
|
1052
|
defined $value or $value = 'console'; |
206
|
|
|
|
|
|
|
|
207
|
254
|
100
|
|
|
|
1273
|
is_module_name($value) |
208
|
|
|
|
|
|
|
or croak "Cannot load logger engine '$value': illegal module name"; |
209
|
|
|
|
|
|
|
|
210
|
253
|
|
|
|
|
5845
|
my $engine_options = |
211
|
|
|
|
|
|
|
$self->_get_config_for_engine( logger => $value, $config ); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
my $logger = $self->_factory->create( |
214
|
|
|
|
|
|
|
logger => $value, |
215
|
253
|
|
|
|
|
5670
|
%{$engine_options}, |
|
253
|
|
|
|
|
7282
|
|
216
|
|
|
|
|
|
|
location => $self->config_location, |
217
|
|
|
|
|
|
|
environment => $self->environment, |
218
|
|
|
|
|
|
|
app_name => $self->name, |
219
|
|
|
|
|
|
|
postponed_hooks => $self->postponed_hooks |
220
|
|
|
|
|
|
|
); |
221
|
|
|
|
|
|
|
|
222
|
253
|
100
|
|
|
|
6042
|
exists $config->{log} and $logger->log_level($config->{log}); |
223
|
|
|
|
|
|
|
|
224
|
253
|
|
|
|
|
7435
|
return $logger; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub _build_session_engine { |
228
|
176
|
|
|
176
|
|
26995
|
my $self = shift; |
229
|
176
|
|
|
|
|
456
|
my $value = shift; |
230
|
176
|
|
|
|
|
404
|
my $config = shift; |
231
|
|
|
|
|
|
|
|
232
|
176
|
100
|
|
|
|
3868
|
defined $config or $config = $self->config; |
233
|
176
|
100
|
100
|
|
|
3171
|
defined $value or $value = $config->{'session'} || 'simple'; |
234
|
|
|
|
|
|
|
|
235
|
176
|
100
|
|
|
|
946
|
is_ref($value) and return $value; |
236
|
|
|
|
|
|
|
|
237
|
173
|
100
|
|
|
|
1098
|
is_module_name($value) |
238
|
|
|
|
|
|
|
or croak "Cannot load session engine '$value': illegal module name"; |
239
|
|
|
|
|
|
|
|
240
|
172
|
|
|
|
|
4084
|
my $engine_options = |
241
|
|
|
|
|
|
|
$self->_get_config_for_engine( session => $value, $config ); |
242
|
|
|
|
|
|
|
|
243
|
172
|
|
|
|
|
1003
|
Scalar::Util::weaken( my $weak_self = $self ); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Note that engine options will replace the default session_dir (if provided). |
246
|
|
|
|
|
|
|
return $self->_factory->create( |
247
|
|
|
|
|
|
|
session => $value, |
248
|
|
|
|
|
|
|
session_dir => path( $self->config->{appdir}, 'sessions' ), |
249
|
172
|
|
|
|
|
2774
|
%{$engine_options}, |
250
|
|
|
|
|
|
|
postponed_hooks => $self->postponed_hooks, |
251
|
|
|
|
|
|
|
|
252
|
3
|
|
|
3
|
|
31
|
log_cb => sub { $weak_self->log(@_) }, |
253
|
172
|
|
|
|
|
3805
|
); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub _build_template_engine { |
257
|
165
|
|
|
165
|
|
5213
|
my $self = shift; |
258
|
165
|
|
|
|
|
489
|
my $value = shift; |
259
|
165
|
|
|
|
|
403
|
my $config = shift; |
260
|
|
|
|
|
|
|
|
261
|
165
|
100
|
|
|
|
3495
|
defined $config or $config = $self->config; |
262
|
165
|
100
|
|
|
|
2521
|
defined $value or $value = $config->{'template'}; |
263
|
|
|
|
|
|
|
|
264
|
165
|
50
|
|
|
|
873
|
defined $value or return; |
265
|
165
|
50
|
|
|
|
720
|
is_ref($value) and return $value; |
266
|
|
|
|
|
|
|
|
267
|
165
|
100
|
|
|
|
873
|
is_module_name($value) |
268
|
|
|
|
|
|
|
or croak "Cannot load template engine '$value': illegal module name"; |
269
|
|
|
|
|
|
|
|
270
|
164
|
|
|
|
|
3526
|
my $engine_options = |
271
|
|
|
|
|
|
|
$self->_get_config_for_engine( template => $value, $config ); |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
my $engine_attrs = { |
274
|
|
|
|
|
|
|
config => $engine_options, |
275
|
|
|
|
|
|
|
layout => $config->{layout}, |
276
|
|
|
|
|
|
|
layout_dir => ( $config->{layout_dir} || 'layouts' ), |
277
|
|
|
|
|
|
|
views => $config->{views}, |
278
|
164
|
|
50
|
|
|
2290
|
}; |
279
|
|
|
|
|
|
|
|
280
|
164
|
|
|
|
|
1092
|
Scalar::Util::weaken( my $weak_self = $self ); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
return $self->_factory->create( |
283
|
|
|
|
|
|
|
template => $value, |
284
|
164
|
|
|
|
|
4570
|
%{$engine_attrs}, |
285
|
|
|
|
|
|
|
postponed_hooks => $self->postponed_hooks, |
286
|
|
|
|
|
|
|
|
287
|
7
|
|
|
7
|
|
43
|
log_cb => sub { $weak_self->log(@_) }, |
288
|
164
|
|
|
|
|
3942
|
); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub _build_serializer_engine { |
292
|
20
|
|
|
20
|
|
70
|
my $self = shift; |
293
|
20
|
|
|
|
|
54
|
my $value = shift; |
294
|
20
|
|
|
|
|
48
|
my $config = shift; |
295
|
|
|
|
|
|
|
|
296
|
20
|
50
|
|
|
|
80
|
defined $config or $config = $self->config; |
297
|
20
|
50
|
|
|
|
96
|
defined $value or $value = $config->{serializer}; |
298
|
|
|
|
|
|
|
|
299
|
20
|
50
|
|
|
|
84
|
defined $value or return; |
300
|
20
|
50
|
|
|
|
70
|
is_ref($value) and return $value; |
301
|
|
|
|
|
|
|
|
302
|
20
|
|
|
|
|
121
|
my $engine_options = |
303
|
|
|
|
|
|
|
$self->_get_config_for_engine( serializer => $value, $config ); |
304
|
|
|
|
|
|
|
|
305
|
20
|
|
|
|
|
145
|
Scalar::Util::weaken( my $weak_self = $self ); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
return $self->_factory->create( |
308
|
|
|
|
|
|
|
serializer => $value, |
309
|
|
|
|
|
|
|
config => $engine_options, |
310
|
|
|
|
|
|
|
postponed_hooks => $self->postponed_hooks, |
311
|
|
|
|
|
|
|
|
312
|
6
|
|
|
6
|
|
50
|
log_cb => sub { $weak_self->log(@_) }, |
313
|
20
|
|
|
|
|
500
|
); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub _get_config_for_engine { |
317
|
614
|
|
|
614
|
|
2311
|
my $self = shift; |
318
|
614
|
|
|
|
|
1398
|
my $engine = shift; |
319
|
614
|
|
|
|
|
1312
|
my $name = shift; |
320
|
614
|
|
|
|
|
1259
|
my $config = shift; |
321
|
|
|
|
|
|
|
|
322
|
614
|
100
|
100
|
|
|
3729
|
defined $config->{'engines'} && defined $config->{'engines'}{$engine} |
323
|
|
|
|
|
|
|
or return {}; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# try both camelized name and regular name |
326
|
24
|
|
|
|
|
64
|
my $engine_config = {}; |
327
|
24
|
|
|
|
|
125
|
foreach my $engine_name ( $name, Dancer2::Core::camelize($name) ) { |
328
|
31
|
100
|
|
|
|
182
|
if ( defined $config->{'engines'}{$engine}{$engine_name} ) { |
329
|
20
|
|
|
|
|
69
|
$engine_config = $config->{'engines'}{$engine}{$engine_name}; |
330
|
20
|
|
|
|
|
59
|
last; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
24
|
|
|
|
|
80
|
return $engine_config; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
has postponed_hooks => ( |
338
|
|
|
|
|
|
|
is => 'ro', |
339
|
|
|
|
|
|
|
isa => HashRef, |
340
|
|
|
|
|
|
|
default => sub { {} }, |
341
|
|
|
|
|
|
|
); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# TODO I'd be happier with a HashRef, really |
344
|
|
|
|
|
|
|
has plugins => ( |
345
|
|
|
|
|
|
|
is => 'rw', |
346
|
|
|
|
|
|
|
isa => ArrayRef, |
347
|
|
|
|
|
|
|
default => sub { [] }, |
348
|
|
|
|
|
|
|
); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
has route_handlers => ( |
351
|
|
|
|
|
|
|
is => 'rw', |
352
|
|
|
|
|
|
|
isa => ArrayRef, |
353
|
|
|
|
|
|
|
default => sub { [] }, |
354
|
|
|
|
|
|
|
); |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
has name => ( |
357
|
|
|
|
|
|
|
is => 'ro', |
358
|
|
|
|
|
|
|
isa => Str, |
359
|
|
|
|
|
|
|
default => sub { (caller(1))[0] }, |
360
|
|
|
|
|
|
|
); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
has request => ( |
363
|
|
|
|
|
|
|
is => 'ro', |
364
|
|
|
|
|
|
|
isa => InstanceOf['Dancer2::Core::Request'], |
365
|
|
|
|
|
|
|
writer => '_set_request', |
366
|
|
|
|
|
|
|
clearer => 'clear_request', |
367
|
|
|
|
|
|
|
predicate => 'has_request', |
368
|
|
|
|
|
|
|
); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub set_request { |
371
|
687
|
|
|
687
|
0
|
1681
|
my ($self, $request, $defined_engines) = @_; |
372
|
|
|
|
|
|
|
# typically this is passed in as an optimization within the |
373
|
|
|
|
|
|
|
# dispatch loop but may be called elsewhere |
374
|
687
|
|
66
|
|
|
2091
|
$defined_engines ||= $self->defined_engines; |
375
|
|
|
|
|
|
|
# populate request in app and all engines |
376
|
687
|
|
|
|
|
17424
|
$self->_set_request($request); |
377
|
687
|
|
|
|
|
22304
|
Scalar::Util::weaken( my $weak_request = $request ); |
378
|
687
|
|
|
|
|
1143
|
$_->set_request( $weak_request ) for @{$defined_engines}; |
|
687
|
|
|
|
|
13603
|
|
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
has response => ( |
382
|
|
|
|
|
|
|
is => 'ro', |
383
|
|
|
|
|
|
|
isa => InstanceOf['Dancer2::Core::Response'], |
384
|
|
|
|
|
|
|
lazy => 1, |
385
|
|
|
|
|
|
|
writer => 'set_response', |
386
|
|
|
|
|
|
|
clearer => 'clear_response', |
387
|
|
|
|
|
|
|
builder => '_build_response', |
388
|
|
|
|
|
|
|
predicate => 'has_response', |
389
|
|
|
|
|
|
|
); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
has with_return => ( |
392
|
|
|
|
|
|
|
is => 'ro', |
393
|
|
|
|
|
|
|
predicate => 1, |
394
|
|
|
|
|
|
|
writer => 'set_with_return', |
395
|
|
|
|
|
|
|
clearer => 'clear_with_return', |
396
|
|
|
|
|
|
|
); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
has session => ( |
399
|
|
|
|
|
|
|
is => 'ro', |
400
|
|
|
|
|
|
|
isa => InstanceOf['Dancer2::Core::Session'], |
401
|
|
|
|
|
|
|
lazy => 1, |
402
|
|
|
|
|
|
|
builder => '_build_session', |
403
|
|
|
|
|
|
|
writer => 'set_session', |
404
|
|
|
|
|
|
|
clearer => 'clear_session', |
405
|
|
|
|
|
|
|
predicate => '_has_session', |
406
|
|
|
|
|
|
|
); |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
around _build_config => sub { |
409
|
|
|
|
|
|
|
my ( $orig, $self ) = @_; |
410
|
|
|
|
|
|
|
my $config = $self->$orig; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
if ( $config && $config->{'engines'} ) { |
413
|
|
|
|
|
|
|
$self->_validate_engine($_) for keys %{ $config->{'engines'} }; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
return $config; |
417
|
|
|
|
|
|
|
}; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub _build_response { |
420
|
651
|
|
|
651
|
|
7205
|
my $self = shift; |
421
|
|
|
|
|
|
|
return Dancer2::Core::Response->new( |
422
|
651
|
100
|
|
|
|
10611
|
server_tokens => !$self->config->{'no_server_tokens'}, |
423
|
|
|
|
|
|
|
$self->has_serializer_engine |
424
|
|
|
|
|
|
|
? ( serializer => $self->serializer_engine ) |
425
|
|
|
|
|
|
|
: (), |
426
|
|
|
|
|
|
|
); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub _build_session { |
430
|
93
|
|
|
93
|
|
1013
|
my $self = shift; |
431
|
93
|
|
|
|
|
158
|
my $session; |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
# Find the session engine |
434
|
93
|
|
|
|
|
3338
|
my $engine = $self->session_engine; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# find the session cookie if any |
437
|
93
|
100
|
|
|
|
914
|
if ( !$self->has_destroyed_session ) { |
438
|
88
|
|
|
|
|
150
|
my $session_id; |
439
|
88
|
|
|
|
|
319
|
my $session_cookie = $self->cookie( $engine->cookie_name ); |
440
|
88
|
100
|
|
|
|
1210
|
defined $session_cookie and |
441
|
|
|
|
|
|
|
$session_id = $session_cookie->value; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# if we have a session cookie, try to retrieve the session |
444
|
88
|
100
|
|
|
|
294
|
if ( defined $session_id ) { |
445
|
|
|
|
|
|
|
eval { |
446
|
|
|
|
|
|
|
$EVAL_SHIM->(sub { |
447
|
53
|
|
|
53
|
|
262
|
$session = $engine->retrieve( id => $session_id ); |
448
|
53
|
|
|
|
|
355
|
}); |
449
|
50
|
|
|
|
|
329
|
1; |
450
|
|
|
|
|
|
|
} |
451
|
53
|
100
|
|
|
|
117
|
or do { |
452
|
3
|
|
50
|
|
|
147
|
my $err = $@ || "Zombie Error"; |
453
|
3
|
50
|
|
|
|
14
|
if ( $err !~ /Unable to retrieve session/ ) { |
454
|
0
|
|
|
|
|
0
|
croak "Failed to retrieve session: $err" |
455
|
|
|
|
|
|
|
} else { |
456
|
|
|
|
|
|
|
# XXX we throw away the error entirely? Why? |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
}; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# create the session if none retrieved |
463
|
93
|
|
66
|
|
|
1191
|
return $session ||= $engine->create(); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub has_session { |
467
|
909
|
|
|
909
|
1
|
1496
|
my $self = shift; |
468
|
|
|
|
|
|
|
|
469
|
909
|
|
|
|
|
14408
|
my $engine = $self->session_engine; |
470
|
|
|
|
|
|
|
|
471
|
909
|
|
66
|
|
|
15208
|
return $self->_has_session |
472
|
|
|
|
|
|
|
|| ( $self->cookie( $engine->cookie_name ) |
473
|
|
|
|
|
|
|
&& !$self->has_destroyed_session ); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
has destroyed_session => ( |
477
|
|
|
|
|
|
|
is => 'ro', |
478
|
|
|
|
|
|
|
isa => InstanceOf ['Dancer2::Core::Session'], |
479
|
|
|
|
|
|
|
predicate => 1, |
480
|
|
|
|
|
|
|
writer => 'set_destroyed_session', |
481
|
|
|
|
|
|
|
clearer => 'clear_destroyed_session', |
482
|
|
|
|
|
|
|
); |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
has 'prep_apps' => ( |
485
|
|
|
|
|
|
|
'is' => 'ro', |
486
|
|
|
|
|
|
|
'isa' => ArrayRef, |
487
|
|
|
|
|
|
|
'default' => sub { [] }, |
488
|
|
|
|
|
|
|
); |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub find_plugin { |
491
|
2
|
|
|
2
|
0
|
7
|
my ( $self, $name ) = @_; |
492
|
2
|
|
|
2
|
|
9
|
my $plugin = List::Util::first { ref($_) eq $name } @{ $self->plugins }; |
|
2
|
|
|
|
|
20
|
|
|
2
|
|
|
|
|
47
|
|
493
|
2
|
100
|
|
|
|
21
|
$plugin or return; |
494
|
1
|
|
|
|
|
4
|
return $plugin; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub destroy_session { |
498
|
17
|
|
|
17
|
1
|
38
|
my $self = shift; |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# Find the session engine |
501
|
17
|
|
|
|
|
289
|
my $engine = $self->session_engine; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# Expire session, set the expired cookie and destroy the session |
504
|
|
|
|
|
|
|
# Setting the cookie ensures client gets an expired cookie unless |
505
|
|
|
|
|
|
|
# a new session is created and supercedes it |
506
|
17
|
|
|
|
|
372
|
my $session = $self->session; |
507
|
17
|
|
|
|
|
606
|
$session->expires(-86400); # yesterday |
508
|
17
|
|
|
|
|
1827
|
$engine->destroy( id => $session->id ); |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# Invalidate session cookie in request |
511
|
|
|
|
|
|
|
# and clear session in app and engines |
512
|
17
|
|
|
|
|
338
|
$self->set_destroyed_session($session); |
513
|
17
|
|
|
|
|
838
|
$self->clear_session; |
514
|
17
|
|
|
|
|
105
|
$_->clear_session for @{ $self->defined_engines }; |
|
17
|
|
|
|
|
72
|
|
515
|
|
|
|
|
|
|
|
516
|
17
|
|
|
|
|
2054
|
return; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub setup_session { |
520
|
118
|
|
|
118
|
0
|
205
|
my $self = shift; |
521
|
|
|
|
|
|
|
|
522
|
118
|
|
|
|
|
188
|
for my $engine ( @{ $self->defined_engines } ) { |
|
118
|
|
|
|
|
276
|
|
523
|
354
|
50
|
|
|
|
15783
|
$self->has_session ? |
524
|
|
|
|
|
|
|
$engine->set_session( $self->session ) : |
525
|
|
|
|
|
|
|
$engine->clear_session; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub change_session_id { |
530
|
5
|
|
|
5
|
1
|
14
|
my $self = shift; |
531
|
|
|
|
|
|
|
|
532
|
5
|
|
|
|
|
93
|
my $session = $self->session; |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# Find the session engine |
535
|
5
|
|
|
|
|
217
|
my $engine = $self->session_engine; |
536
|
|
|
|
|
|
|
|
537
|
5
|
100
|
|
|
|
95
|
if ($engine->can('_change_id')) { |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# session engine can change session ID |
540
|
3
|
|
|
|
|
24
|
$engine->change_id( session => $session ); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
else { |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# Method order is important in here... |
545
|
|
|
|
|
|
|
# |
546
|
|
|
|
|
|
|
# On session build if there is no destroyed session then the session |
547
|
|
|
|
|
|
|
# builder tries to recreate the session using the existing session |
548
|
|
|
|
|
|
|
# cookie. We really don't want to do that in this case so it is |
549
|
|
|
|
|
|
|
# important to create the new session before the |
550
|
|
|
|
|
|
|
# clear_destroyed_session method is called. |
551
|
|
|
|
|
|
|
# |
552
|
|
|
|
|
|
|
# This sucks. |
553
|
|
|
|
|
|
|
# |
554
|
|
|
|
|
|
|
# Sawyer suggested: |
555
|
|
|
|
|
|
|
# |
556
|
|
|
|
|
|
|
# What if you take the session cookie logic out of that attribute into |
557
|
|
|
|
|
|
|
# another attribute and clear that attribute? |
558
|
|
|
|
|
|
|
# That would force the session rebuilt to rebuilt the attribute and |
559
|
|
|
|
|
|
|
# get a different cookie value, no? |
560
|
|
|
|
|
|
|
# |
561
|
|
|
|
|
|
|
# TODO: think about this some more. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
# grab data, destroy session and store data again |
564
|
2
|
|
|
|
|
8
|
my %data = %{$session->data}; |
|
2
|
|
|
|
|
38
|
|
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# destroy existing session |
567
|
2
|
|
|
|
|
32
|
$self->destroy_session; |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# get new session |
570
|
2
|
|
|
|
|
34
|
$session = $self->session; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# write data from old session into new |
573
|
|
|
|
|
|
|
# Some engines add session id to data so skip id. |
574
|
2
|
|
|
|
|
344
|
while (my ($key, $value) = each %data ) { |
575
|
2
|
50
|
|
|
|
44
|
$session->write($key => $value) unless $key eq 'id'; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
# clear out destroyed session - no longer relevant |
579
|
2
|
|
|
|
|
57
|
$self->clear_destroyed_session; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
5
|
|
|
|
|
130
|
return $session->id; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
has prefix => ( |
586
|
|
|
|
|
|
|
is => 'rw', |
587
|
|
|
|
|
|
|
isa => Maybe [Dancer2Prefix], |
588
|
|
|
|
|
|
|
predicate => 1, |
589
|
|
|
|
|
|
|
coerce => sub { |
590
|
|
|
|
|
|
|
my $prefix = shift; |
591
|
|
|
|
|
|
|
defined($prefix) and $prefix eq "/" and return; |
592
|
|
|
|
|
|
|
return $prefix; |
593
|
|
|
|
|
|
|
}, |
594
|
|
|
|
|
|
|
); |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# routes registry, stored by method: |
597
|
|
|
|
|
|
|
has routes => ( |
598
|
|
|
|
|
|
|
is => 'rw', |
599
|
|
|
|
|
|
|
isa => HashRef, |
600
|
|
|
|
|
|
|
default => sub { |
601
|
|
|
|
|
|
|
{ get => [], |
602
|
|
|
|
|
|
|
head => [], |
603
|
|
|
|
|
|
|
post => [], |
604
|
|
|
|
|
|
|
put => [], |
605
|
|
|
|
|
|
|
del => [], |
606
|
|
|
|
|
|
|
options => [], |
607
|
|
|
|
|
|
|
}; |
608
|
|
|
|
|
|
|
}, |
609
|
|
|
|
|
|
|
); |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# add_hook will add the hook to the first "hook candidate" it finds that support |
612
|
|
|
|
|
|
|
# it. If none, then it will try to add the hook to the current application. |
613
|
|
|
|
|
|
|
around add_hook => sub { |
614
|
|
|
|
|
|
|
my $orig = shift; |
615
|
|
|
|
|
|
|
my $self = shift; |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# saving caller information |
618
|
|
|
|
|
|
|
my ( $package, $file, $line ) = caller(4); # deep to 4 : user's app code |
619
|
|
|
|
|
|
|
my $add_hook_caller = [ $package, $file, $line ]; |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
my ($hook) = @_; |
622
|
|
|
|
|
|
|
my $name = $hook->name; |
623
|
|
|
|
|
|
|
my $hook_aliases = $self->all_hook_aliases; |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# look for an alias |
626
|
|
|
|
|
|
|
defined $hook_aliases->{$name} and $name = $hook_aliases->{$name}; |
627
|
|
|
|
|
|
|
$hook->name($name); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# if that hook belongs to the app, register it now and return |
630
|
|
|
|
|
|
|
$self->has_hook($name) and return $self->$orig(@_); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# at this point the hook name must be formatted like: |
633
|
|
|
|
|
|
|
# '$type.$candidate.$name', eg: 'engine.template.before_render' or |
634
|
|
|
|
|
|
|
# 'plugin.database.before_dbi_connect' |
635
|
|
|
|
|
|
|
my ( $hookable_type, $hookable_name, $hook_name ) = split( /\./, $name ); |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
( defined $hookable_name && defined $hook_name ) |
638
|
|
|
|
|
|
|
or croak "Invalid hook name `$name'"; |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
grep /^$hookable_type$/, qw(core engine handler plugin) |
641
|
|
|
|
|
|
|
or croak "Unknown hook type `$hookable_type'"; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# register the hooks for existing hookable candidates |
644
|
|
|
|
|
|
|
foreach my $hookable ( $self->hook_candidates ) { |
645
|
|
|
|
|
|
|
$hookable->has_hook($name) and $hookable->add_hook(@_); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# we register the hook for upcoming objects; |
649
|
|
|
|
|
|
|
# that way, each components that can claim the hook will have a chance |
650
|
|
|
|
|
|
|
# to register it. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $postponed_hooks = $self->postponed_hooks; |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# Hmm, so the hook was not claimed, at this point we'll cache it and |
655
|
|
|
|
|
|
|
# register it when the owner is instantiated |
656
|
|
|
|
|
|
|
$postponed_hooks->{$hookable_type}{$hookable_name} ||= {}; |
657
|
|
|
|
|
|
|
$postponed_hooks->{$hookable_type}{$hookable_name}{$name} ||= {}; |
658
|
|
|
|
|
|
|
$postponed_hooks->{$hookable_type}{$hookable_name}{$name}{hook} = $hook; |
659
|
|
|
|
|
|
|
$postponed_hooks->{$hookable_type}{$hookable_name}{$name}{caller} = |
660
|
|
|
|
|
|
|
$add_hook_caller; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
}; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
around execute_hook => sub { |
665
|
|
|
|
|
|
|
my $orig = shift; |
666
|
|
|
|
|
|
|
my $self = shift; |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
local $Dancer2::Core::Route::REQUEST = $self->request; |
669
|
|
|
|
|
|
|
local $Dancer2::Core::Route::RESPONSE = $self->response; |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
my ( $hook, @args ) = @_; |
672
|
|
|
|
|
|
|
if ( !$self->has_hook($hook) ) { |
673
|
|
|
|
|
|
|
foreach my $cand ( $self->hook_candidates ) { |
674
|
|
|
|
|
|
|
$cand->has_hook($hook) and return $cand->execute_hook(@_); |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
return $self->$orig(@_); |
679
|
|
|
|
|
|
|
}; |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
sub _build_default_config { |
682
|
237
|
|
|
237
|
|
3888
|
my $self = shift; |
683
|
|
|
|
|
|
|
|
684
|
237
|
|
33
|
|
|
2043
|
my $public = $ENV{DANCER_PUBLIC} || path( $self->location, 'public' ); |
685
|
|
|
|
|
|
|
return { |
686
|
|
|
|
|
|
|
content_type => ( $ENV{DANCER_CONTENT_TYPE} || 'text/html' ), |
687
|
|
|
|
|
|
|
charset => ( $ENV{DANCER_CHARSET} || '' ), |
688
|
|
|
|
|
|
|
logger => ( $ENV{DANCER_LOGGER} || 'console' ), |
689
|
|
|
|
|
|
|
views => ( $ENV{DANCER_VIEWS} |
690
|
237
|
|
50
|
|
|
4322
|
|| path( $self->location, 'views' ) ), |
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
33
|
|
|
|
|
691
|
|
|
|
|
|
|
environment => $self->environment, |
692
|
|
|
|
|
|
|
appdir => $self->location, |
693
|
|
|
|
|
|
|
public_dir => $public, |
694
|
|
|
|
|
|
|
template => 'Tiny', |
695
|
|
|
|
|
|
|
route_handlers => [ |
696
|
|
|
|
|
|
|
[ |
697
|
|
|
|
|
|
|
AutoPage => 1 |
698
|
|
|
|
|
|
|
], |
699
|
|
|
|
|
|
|
], |
700
|
|
|
|
|
|
|
}; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
sub _init_hooks { |
704
|
236
|
|
|
236
|
|
681
|
my $self = shift; |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
# Hook to flush the session at the end of the request, |
707
|
|
|
|
|
|
|
# this way, we're sure we flush only once per request |
708
|
|
|
|
|
|
|
# |
709
|
|
|
|
|
|
|
# Note: we create a weakened copy $self |
710
|
|
|
|
|
|
|
# before closing over the weakened copy |
711
|
|
|
|
|
|
|
# to avoid circular memory refs. |
712
|
236
|
|
|
|
|
949
|
Scalar::Util::weaken(my $app = $self); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
$self->add_hook( |
715
|
|
|
|
|
|
|
Dancer2::Core::Hook->new( |
716
|
|
|
|
|
|
|
name => 'core.app.after_request', |
717
|
|
|
|
|
|
|
code => sub { |
718
|
467
|
|
|
467
|
|
893
|
my $response = $Dancer2::Core::Route::RESPONSE; |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# make sure an engine is defined, if not, nothing to do |
721
|
467
|
|
|
|
|
8126
|
my $engine = $app->session_engine; |
722
|
467
|
50
|
|
|
|
4285
|
defined $engine or return; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
# if a session has been instantiated or we already had a |
725
|
|
|
|
|
|
|
# session, first flush the session so cookie-based sessions can |
726
|
|
|
|
|
|
|
# update the session ID if needed, then set the session cookie |
727
|
|
|
|
|
|
|
# in the response |
728
|
|
|
|
|
|
|
# |
729
|
|
|
|
|
|
|
# if there is NO session object but the request has a cookie with |
730
|
|
|
|
|
|
|
# a session key, create a dummy session with the same ID (without |
731
|
|
|
|
|
|
|
# actually retrieving and flushing immediately) and generate the |
732
|
|
|
|
|
|
|
# cookie header from the dummy session. Lazy Sessions FTW! |
733
|
|
|
|
|
|
|
|
734
|
467
|
100
|
|
|
|
1606
|
if ( $app->has_session ) { |
|
|
100
|
|
|
|
|
|
735
|
76
|
|
|
|
|
176
|
my $session; |
736
|
76
|
100
|
|
|
|
208
|
if ( $app->_has_session ) { # Session object exists |
737
|
73
|
|
|
|
|
1147
|
$session = $app->session; |
738
|
73
|
100
|
|
|
|
1654
|
$session->is_dirty and $engine->flush( session => $session ); |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
else { # Cookie header exists. Create a dummy session object |
741
|
3
|
|
|
|
|
17
|
my $cookie = $app->cookie( $engine->cookie_name ); |
742
|
3
|
|
|
|
|
62
|
my $session_id = $cookie->value; |
743
|
3
|
|
|
|
|
57
|
$session = Dancer2::Core::Session->new( id => $session_id ); |
744
|
|
|
|
|
|
|
} |
745
|
76
|
|
|
|
|
784
|
$engine->set_cookie_header( |
746
|
|
|
|
|
|
|
response => $response, |
747
|
|
|
|
|
|
|
session => $session |
748
|
|
|
|
|
|
|
); |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
elsif ( $app->has_destroyed_session ) { |
751
|
12
|
|
|
|
|
53
|
my $session = $app->destroyed_session; |
752
|
12
|
|
|
|
|
72
|
$engine->set_cookie_header( |
753
|
|
|
|
|
|
|
response => $response, |
754
|
|
|
|
|
|
|
session => $session, |
755
|
|
|
|
|
|
|
destroyed => 1 |
756
|
|
|
|
|
|
|
); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
}, |
759
|
|
|
|
|
|
|
) |
760
|
236
|
|
|
|
|
4778
|
); |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub supported_hooks { |
764
|
444
|
|
|
444
|
0
|
5079
|
qw/ |
765
|
|
|
|
|
|
|
core.app.before_request |
766
|
|
|
|
|
|
|
core.app.after_request |
767
|
|
|
|
|
|
|
core.app.route_exception |
768
|
|
|
|
|
|
|
core.app.before_file_render |
769
|
|
|
|
|
|
|
core.app.after_file_render |
770
|
|
|
|
|
|
|
core.error.before |
771
|
|
|
|
|
|
|
core.error.after |
772
|
|
|
|
|
|
|
core.error.init |
773
|
|
|
|
|
|
|
/; |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
sub hook_aliases { |
777
|
1785
|
|
|
1785
|
0
|
3307
|
my $self = shift; |
778
|
1785
|
|
100
|
|
|
12616
|
$self->{'hook_aliases'} ||= { |
779
|
|
|
|
|
|
|
before => 'core.app.before_request', |
780
|
|
|
|
|
|
|
before_request => 'core.app.before_request', |
781
|
|
|
|
|
|
|
after => 'core.app.after_request', |
782
|
|
|
|
|
|
|
after_request => 'core.app.after_request', |
783
|
|
|
|
|
|
|
init_error => 'core.error.init', |
784
|
|
|
|
|
|
|
before_error => 'core.error.before', |
785
|
|
|
|
|
|
|
after_error => 'core.error.after', |
786
|
|
|
|
|
|
|
on_route_exception => 'core.app.route_exception', |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
before_file_render => 'core.app.before_file_render', |
789
|
|
|
|
|
|
|
after_file_render => 'core.app.after_file_render', |
790
|
|
|
|
|
|
|
before_handler_file_render => 'handler.file.before_render', |
791
|
|
|
|
|
|
|
after_handler_file_render => 'handler.file.after_render', |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# compatibility from Dancer1 |
795
|
|
|
|
|
|
|
before_error_render => 'core.error.before', |
796
|
|
|
|
|
|
|
after_error_render => 'core.error.after', |
797
|
|
|
|
|
|
|
before_error_init => 'core.error.init', |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
# TODO: call $engine->hook_aliases as needed |
800
|
|
|
|
|
|
|
# But.. currently there are use cases where hook_aliases |
801
|
|
|
|
|
|
|
# are needed before the engines are intiialized :( |
802
|
|
|
|
|
|
|
before_template_render => 'engine.template.before_render', |
803
|
|
|
|
|
|
|
after_template_render => 'engine.template.after_render', |
804
|
|
|
|
|
|
|
before_layout_render => 'engine.template.before_layout_render', |
805
|
|
|
|
|
|
|
after_layout_render => 'engine.template.after_layout_render', |
806
|
|
|
|
|
|
|
before_serializer => 'engine.serializer.before', |
807
|
|
|
|
|
|
|
after_serializer => 'engine.serializer.after', |
808
|
|
|
|
|
|
|
}; |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
sub defined_engines { |
812
|
1579
|
|
|
1579
|
0
|
3114
|
my $self = shift; |
813
|
|
|
|
|
|
|
return [ |
814
|
1579
|
100
|
|
|
|
25979
|
$self->template_engine, |
815
|
|
|
|
|
|
|
$self->session_engine, |
816
|
|
|
|
|
|
|
$self->logger_engine, |
817
|
|
|
|
|
|
|
$self->has_serializer_engine |
818
|
|
|
|
|
|
|
? $self->serializer_engine |
819
|
|
|
|
|
|
|
: (), |
820
|
|
|
|
|
|
|
]; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
# FIXME not needed anymore, I suppose... |
824
|
0
|
|
|
0
|
0
|
0
|
sub api_version {2} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
sub register_plugin { |
827
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
828
|
0
|
|
|
|
|
0
|
my $plugin = shift; |
829
|
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
0
|
$self->log( core => "Registered $plugin"); |
831
|
|
|
|
|
|
|
|
832
|
0
|
|
|
|
|
0
|
push @{ $self->plugins }, $plugin; |
|
0
|
|
|
|
|
0
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# This method overrides the default one from Role::ConfigReader |
836
|
|
|
|
|
|
|
sub settings { |
837
|
905
|
|
|
905
|
0
|
1821
|
my $self = shift; |
838
|
905
|
|
|
|
|
1543
|
+{ %{ Dancer2::runner()->config }, %{ $self->config } }; |
|
905
|
|
|
|
|
2441
|
|
|
905
|
|
|
|
|
25228
|
|
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub cleanup { |
842
|
677
|
|
|
677
|
0
|
3022
|
my $self = shift; |
843
|
677
|
|
|
|
|
13507
|
$self->clear_request; |
844
|
677
|
|
|
|
|
14288
|
$self->clear_response; |
845
|
677
|
|
|
|
|
15535
|
$self->clear_session; |
846
|
677
|
|
|
|
|
13653
|
$self->clear_destroyed_session; |
847
|
|
|
|
|
|
|
# Clear engine attributes |
848
|
677
|
|
|
|
|
3662
|
for my $engine ( @{ $self->defined_engines } ) { |
|
677
|
|
|
|
|
1819
|
|
849
|
2112
|
|
|
|
|
72008
|
$engine->clear_session; |
850
|
2112
|
|
|
|
|
39385
|
$engine->clear_request; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
sub _validate_engine { |
855
|
28
|
|
|
28
|
|
63
|
my $self = shift; |
856
|
28
|
|
|
|
|
59
|
my $name = shift; |
857
|
|
|
|
|
|
|
|
858
|
28
|
100
|
|
|
|
56
|
grep +( $_ eq $name ), @{ $self->supported_engines } |
|
28
|
|
|
|
|
98
|
|
859
|
|
|
|
|
|
|
or croak "Engine '$name' is not supported."; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub engine { |
863
|
26
|
|
|
26
|
0
|
725
|
my $self = shift; |
864
|
26
|
|
|
|
|
76
|
my $name = shift; |
865
|
|
|
|
|
|
|
|
866
|
26
|
|
|
|
|
148
|
$self->_validate_engine($name); |
867
|
|
|
|
|
|
|
|
868
|
25
|
|
|
|
|
116
|
my $attr_name = "${name}_engine"; |
869
|
25
|
|
|
|
|
565
|
return $self->$attr_name; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub template { |
873
|
33
|
|
|
33
|
0
|
787
|
my $self = shift; |
874
|
|
|
|
|
|
|
|
875
|
33
|
|
|
|
|
585
|
my $template = $self->template_engine; |
876
|
33
|
|
|
|
|
818
|
$template->set_settings( $self->config ); |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
# A session will not exist if there is no request (global keyword) |
879
|
|
|
|
|
|
|
# |
880
|
|
|
|
|
|
|
# A session may exist but the route code may not have instantiated |
881
|
|
|
|
|
|
|
# the session object (sessions are lazy). If this is the case, do |
882
|
|
|
|
|
|
|
# that now, so the templates have the session data for rendering. |
883
|
33
|
100
|
100
|
|
|
2028
|
$self->has_request && $self->has_session && ! $template->has_session |
|
|
|
100
|
|
|
|
|
884
|
|
|
|
|
|
|
and $self->setup_session; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
# return content |
887
|
33
|
100
|
|
|
|
240
|
if ($self->has_with_return) { |
888
|
29
|
|
|
|
|
108
|
my $old_with_return = $self->with_return; |
889
|
29
|
|
|
|
|
48
|
my $local_response; |
890
|
|
|
|
|
|
|
$self->set_with_return( sub { |
891
|
1
|
|
33
|
1
|
|
22
|
$local_response ||= shift; |
892
|
29
|
|
|
|
|
186
|
}); |
893
|
29
|
|
|
|
|
177
|
my $content = $template->process( @_ ); |
894
|
24
|
|
|
|
|
185
|
$self->set_with_return($old_with_return); |
895
|
24
|
100
|
|
|
|
92
|
if ($local_response) { |
896
|
1
|
|
|
|
|
5
|
$self->with_return->($local_response); |
897
|
|
|
|
|
|
|
} |
898
|
23
|
|
|
|
|
126
|
return $content; |
899
|
|
|
|
|
|
|
} |
900
|
4
|
|
|
|
|
29
|
return $template->process( @_ ); |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub hook_candidates { |
904
|
45
|
|
|
45
|
0
|
92
|
my $self = shift; |
905
|
|
|
|
|
|
|
|
906
|
45
|
|
|
|
|
89
|
my @engines = @{ $self->defined_engines }; |
|
45
|
|
|
|
|
136
|
|
907
|
|
|
|
|
|
|
|
908
|
45
|
|
|
|
|
3790
|
my @route_handlers; |
909
|
45
|
|
|
|
|
88
|
for my $handler ( @{ $self->route_handlers } ) { |
|
45
|
|
|
|
|
853
|
|
910
|
45
|
|
|
|
|
422
|
my $handler_code = $handler->{handler}; |
911
|
45
|
50
|
33
|
|
|
536
|
blessed $handler_code and $handler_code->can('supported_hooks') |
912
|
|
|
|
|
|
|
and push @route_handlers, $handler_code; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
# TODO : get the list of all plugins registered |
916
|
45
|
|
|
|
|
101
|
my @plugins = @{ $self->plugins }; |
|
45
|
|
|
|
|
856
|
|
917
|
|
|
|
|
|
|
|
918
|
45
|
|
|
|
|
542
|
( @route_handlers, @engines, @plugins ); |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
sub all_hook_aliases { |
922
|
316
|
|
|
316
|
0
|
715
|
my $self = shift; |
923
|
|
|
|
|
|
|
|
924
|
316
|
|
|
|
|
1339
|
my $aliases = $self->hook_aliases; |
925
|
316
|
|
|
|
|
835
|
for my $plugin ( grep { $_->can('hook_aliases') } @{ $self->plugins } ) { |
|
13
|
|
|
|
|
161
|
|
|
316
|
|
|
|
|
6147
|
|
926
|
13
|
|
|
|
|
29
|
$aliases = { %{$aliases}, %{ $plugin->hook_aliases } }; |
|
13
|
|
|
|
|
79
|
|
|
13
|
|
|
|
|
45
|
|
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
|
929
|
316
|
|
|
|
|
3720
|
return $aliases; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
sub mime_type { |
933
|
10
|
|
|
10
|
0
|
28
|
my $self = shift; |
934
|
10
|
|
|
|
|
48
|
my $runner = Dancer2::runner(); |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
exists $self->config->{default_mime_type} |
937
|
|
|
|
|
|
|
? $runner->mime_type->default( $self->config->{default_mime_type} ) |
938
|
10
|
100
|
|
|
|
235
|
: $runner->mime_type->reset_default; |
939
|
|
|
|
|
|
|
|
940
|
10
|
|
|
|
|
512
|
$runner->mime_type; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub log { |
944
|
2361
|
|
|
2361
|
0
|
32549
|
my $self = shift; |
945
|
2361
|
|
|
|
|
3818
|
my $level = shift; |
946
|
|
|
|
|
|
|
|
947
|
2361
|
50
|
|
|
|
40742
|
my $logger = $self->logger_engine |
948
|
|
|
|
|
|
|
or croak "No logger defined"; |
949
|
|
|
|
|
|
|
|
950
|
2361
|
|
|
|
|
44615
|
$logger->$level(@_); |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
sub send_as { |
954
|
8
|
|
|
8
|
0
|
12
|
my $self = shift; |
955
|
8
|
|
|
|
|
22
|
my ( $type, $data, $options ) = @_; |
956
|
8
|
|
100
|
|
|
35
|
$options ||= {}; |
957
|
|
|
|
|
|
|
|
958
|
8
|
100
|
|
|
|
211
|
$type or croak "Can not send_as using an undefined type"; |
959
|
|
|
|
|
|
|
|
960
|
7
|
100
|
100
|
|
|
50
|
if ( lc($type) eq 'html' || lc($type) eq 'plain' ) { |
961
|
2
|
50
|
|
|
|
7
|
if ( $type ne lc $type ) { |
962
|
0
|
|
|
|
|
0
|
local $Carp::CarpLevel = 2; |
963
|
0
|
|
|
|
|
0
|
carp sprintf( "Please use %s as the type for 'send_as', not %s", lc($type), $type ); |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
|
966
|
2
|
|
50
|
|
|
37
|
$options->{charset} = $self->config->{charset} || 'UTF-8'; |
967
|
2
|
|
|
|
|
45
|
my $content = Encode::encode( $options->{charset}, $data ); |
968
|
2
|
|
33
|
|
|
101
|
$options->{content_type} ||= join '/', 'text', lc $type; |
969
|
2
|
|
|
|
|
11
|
$self->send_file( \$content, %$options ); # returns from sub |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
# Try and load the serializer class |
973
|
5
|
|
|
|
|
18
|
my $serializer_class = "Dancer2::Serializer::$type"; |
974
|
|
|
|
|
|
|
eval { |
975
|
|
|
|
|
|
|
$EVAL_SHIM->(sub { |
976
|
5
|
|
|
5
|
|
22
|
require_module( $serializer_class ); |
977
|
5
|
|
|
|
|
28
|
}); |
978
|
3
|
|
|
|
|
74
|
1; |
979
|
5
|
100
|
|
|
|
14
|
} or do { |
980
|
2
|
|
50
|
|
|
574
|
my $err = $@ || "Zombie Error"; |
981
|
2
|
|
|
|
|
247
|
croak "Unable to load serializer class for $type: $err"; |
982
|
|
|
|
|
|
|
}; |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
# load any serializer engine config |
985
|
3
|
|
50
|
|
|
67
|
my $engine_options = |
986
|
|
|
|
|
|
|
$self->_get_config_for_engine( serializer => $type, $self->config ) || {}; |
987
|
3
|
|
|
|
|
44
|
my $serializer = $serializer_class->new( config => $engine_options ); |
988
|
3
|
|
|
|
|
71
|
my $content = $serializer->serialize( $data ); |
989
|
3
|
|
66
|
|
|
19
|
$options->{content_type} ||= $serializer->content_type; |
990
|
3
|
|
|
|
|
17
|
$self->send_file( \$content, %$options ); |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
sub send_error { |
994
|
8
|
|
|
8
|
0
|
21
|
my $self = shift; |
995
|
8
|
|
|
|
|
27
|
my ( $message, $status ) = @_; |
996
|
|
|
|
|
|
|
|
997
|
8
|
100
|
|
|
|
157
|
my $err = Dancer2::Core::Error->new( |
998
|
|
|
|
|
|
|
message => $message, |
999
|
|
|
|
|
|
|
app => $self, |
1000
|
|
|
|
|
|
|
( status => $status )x!! $status, |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
$self->has_serializer_engine |
1003
|
|
|
|
|
|
|
? ( serializer => $self->serializer_engine ) |
1004
|
|
|
|
|
|
|
: (), |
1005
|
|
|
|
|
|
|
)->throw; |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
# Immediately return to dispatch if with_return coderef exists |
1008
|
8
|
50
|
|
|
|
189
|
$self->has_with_return && $self->with_return->($err); |
1009
|
0
|
|
|
|
|
0
|
return $err; |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
sub send_file { |
1013
|
16
|
|
|
16
|
0
|
30
|
my $self = shift; |
1014
|
16
|
|
|
|
|
32
|
my $thing = shift; |
1015
|
16
|
|
|
|
|
47
|
my %options = @_; |
1016
|
|
|
|
|
|
|
|
1017
|
16
|
|
|
|
|
48
|
my ($content_type, $charset, $file_path); |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
# are we're given a filehandle? (based on what Plack::Middleware::Lint accepts) |
1020
|
|
|
|
|
|
|
my $is_filehandle = Plack::Util::is_real_fh($thing) |
1021
|
16
|
|
33
|
|
|
59
|
|| ( is_globref($thing) && *{$thing}{IO} && *{$thing}{IO}->can('getline') ) |
1022
|
|
|
|
|
|
|
|| ( Scalar::Util::blessed($thing) && $thing->can('getline') ); |
1023
|
16
|
|
|
|
|
793
|
my ($fh) = ($thing)x!! $is_filehandle; |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
# if we're given an IO::Scalar object, DTRT (take the scalar ref from it) |
1026
|
16
|
50
|
33
|
|
|
54
|
if (Scalar::Util::blessed($thing) && $thing->isa('IO::Scalar')) { |
1027
|
0
|
|
|
|
|
0
|
$thing = $thing->sref; |
1028
|
|
|
|
|
|
|
} |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
# if we're given a SCALAR reference, build a filehandle to it |
1031
|
16
|
100
|
|
|
|
50
|
if ( is_scalarref($thing) ) { |
1032
|
|
|
|
|
|
|
## no critic qw(InputOutput::RequireCheckedOpen) |
1033
|
6
|
|
|
|
|
71
|
open $fh, "<", $thing; |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
# If we haven't got a filehandle, create one to the requested content |
1037
|
16
|
100
|
|
|
|
47
|
if (! $fh) { |
1038
|
9
|
|
|
|
|
18
|
my $path = $thing; |
1039
|
|
|
|
|
|
|
# remove prefix from given path (if not a filehandle) |
1040
|
9
|
|
|
|
|
228
|
my $prefix = $self->prefix; |
1041
|
9
|
50
|
33
|
|
|
98
|
if ( $prefix && $prefix ne '/' ) { |
1042
|
0
|
|
|
|
|
0
|
$path =~ s/^\Q$prefix\E//; |
1043
|
|
|
|
|
|
|
} |
1044
|
|
|
|
|
|
|
# static file dir - either system root or public_dir |
1045
|
|
|
|
|
|
|
my $dir = $options{system_path} |
1046
|
|
|
|
|
|
|
? File::Spec->rootdir |
1047
|
|
|
|
|
|
|
: $ENV{DANCER_PUBLIC} |
1048
|
|
|
|
|
|
|
|| $self->config->{public_dir} |
1049
|
9
|
100
|
33
|
|
|
147
|
|| path( $self->location, 'public' ); |
1050
|
|
|
|
|
|
|
|
1051
|
9
|
|
|
|
|
121
|
$file_path = Dancer2::Handler::File->merge_paths( $path, $dir ); |
1052
|
|
|
|
|
|
|
my $err_response = sub { |
1053
|
0
|
|
|
0
|
|
0
|
my $status = shift; |
1054
|
0
|
|
|
|
|
0
|
$self->response->status($status); |
1055
|
0
|
|
|
|
|
0
|
$self->response->header( 'Content-Type', 'text/plain' ); |
1056
|
0
|
|
|
|
|
0
|
$self->response->content( Dancer2::Core::HTTP->status_message($status) ); |
1057
|
0
|
|
|
|
|
0
|
$self->with_return->( $self->response ); |
1058
|
9
|
|
|
|
|
75
|
}; |
1059
|
9
|
50
|
|
|
|
57
|
$err_response->(403) if !defined $file_path; |
1060
|
9
|
50
|
|
|
|
183
|
$err_response->(404) if !-f $file_path; |
1061
|
9
|
50
|
|
|
|
138
|
$err_response->(403) if !-r $file_path; |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
# Read file content as bytes |
1064
|
9
|
|
|
|
|
48
|
$fh = Dancer2::FileUtils::open_file( "<", $file_path ); |
1065
|
9
|
|
|
|
|
59
|
binmode $fh; |
1066
|
9
|
|
50
|
|
|
33
|
$content_type = Dancer2::runner()->mime_type->for_file($file_path) || 'text/plain'; |
1067
|
9
|
100
|
|
|
|
179
|
if ( $content_type =~ m!^text/! ) { |
1068
|
5
|
|
50
|
|
|
110
|
$charset = $self->config->{charset} || "utf-8"; |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
# Now we are sure we can render the file... |
1073
|
16
|
|
|
|
|
486
|
$self->execute_hook( 'core.app.before_file_render', $file_path ); |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
# response content type and charset |
1076
|
16
|
100
|
|
|
|
195
|
( exists $options{'content_type'} ) and $content_type = $options{'content_type'}; |
1077
|
16
|
100
|
|
|
|
39
|
( exists $options{'charset'} ) and $charset = $options{'charset'}; |
1078
|
16
|
100
|
100
|
|
|
126
|
$content_type .= "; charset=$charset" if $content_type and $charset; |
1079
|
16
|
100
|
|
|
|
291
|
( defined $content_type ) |
1080
|
|
|
|
|
|
|
and $self->response->header('Content-Type' => $content_type ); |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
# content disposition |
1083
|
|
|
|
|
|
|
( exists $options{filename} ) |
1084
|
|
|
|
|
|
|
and $self->response->header( 'Content-Disposition' => |
1085
|
16
|
100
|
100
|
|
|
2041
|
($options{content_disposition} || "attachment") . "; filename=\"$options{filename}\"" ); |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
# use a delayed response unless server does not support streaming |
1088
|
16
|
100
|
|
|
|
223
|
my $use_streaming = exists $options{streaming} ? $options{streaming} : 1; |
1089
|
16
|
|
|
|
|
26
|
my $response; |
1090
|
16
|
|
|
|
|
73
|
my $env = $self->request->env; |
1091
|
16
|
100
|
66
|
|
|
131
|
if ( $env->{'psgi.streaming'} && $use_streaming ) { |
1092
|
|
|
|
|
|
|
my $cb = sub { |
1093
|
15
|
|
|
15
|
|
30
|
my $responder = $Dancer2::Core::Route::RESPONDER; |
1094
|
15
|
|
|
|
|
23
|
my $res = $Dancer2::Core::Route::RESPONSE; |
1095
|
15
|
|
|
|
|
330
|
return $responder->( |
1096
|
|
|
|
|
|
|
[ $res->status, $res->headers_to_array, $fh ] |
1097
|
|
|
|
|
|
|
); |
1098
|
15
|
|
|
|
|
108
|
}; |
1099
|
|
|
|
|
|
|
|
1100
|
15
|
|
|
|
|
74
|
Scalar::Util::weaken( my $weak_self = $self ); |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
$response = Dancer2::Core::Response::Delayed->new( |
1103
|
0
|
|
|
0
|
|
0
|
error_cb => sub { $weak_self->logger_engine->log( warning => @_ ) }, |
1104
|
15
|
|
|
|
|
320
|
cb => $cb, |
1105
|
|
|
|
|
|
|
request => $Dancer2::Core::Route::REQUEST, |
1106
|
|
|
|
|
|
|
response => $Dancer2::Core::Route::RESPONSE, |
1107
|
|
|
|
|
|
|
); |
1108
|
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
|
else { |
1110
|
1
|
|
|
|
|
22
|
$response = $self->response; |
1111
|
|
|
|
|
|
|
# direct assignment to hash element, avoids around modifier |
1112
|
|
|
|
|
|
|
# trying to serialise this this content. |
1113
|
1
|
|
|
|
|
21
|
$response->{content} = Dancer2::FileUtils::read_glob_content($fh); |
1114
|
1
|
|
|
|
|
28
|
$response->is_encoded(1); # bytes are already encoded |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
|
1117
|
16
|
|
|
|
|
14568
|
$self->execute_hook( 'core.app.after_file_render', $response ); |
1118
|
16
|
|
|
|
|
181
|
$self->with_return->( $response ); |
1119
|
|
|
|
|
|
|
} |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
sub BUILD { |
1122
|
|
|
|
|
|
|
my $self = shift; |
1123
|
|
|
|
|
|
|
$self->init_route_handlers(); |
1124
|
|
|
|
|
|
|
$self->_init_hooks(); |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
$self->log(core => 'Built config from files: ' . join(' ', @{$self->config_files})); |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
sub finish { |
1130
|
205
|
|
|
205
|
0
|
540
|
my $self = shift; |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
# normalize some values that require calculations |
1133
|
|
|
|
|
|
|
defined $self->config->{'static_handler'} |
1134
|
205
|
100
|
|
|
|
3440
|
or $self->config->{'static_handler'} = -d $self->config->{'public_dir'}; |
1135
|
|
|
|
|
|
|
|
1136
|
205
|
|
|
|
|
13686
|
$self->register_route_handlers; |
1137
|
205
|
|
|
|
|
3055
|
$self->compile_hooks; |
1138
|
|
|
|
|
|
|
|
1139
|
205
|
50
|
66
|
|
|
1898
|
@{$self->plugins} |
|
205
|
|
|
|
|
3972
|
|
1140
|
|
|
|
|
|
|
&& $self->plugins->[0]->can('_add_postponed_plugin_hooks') |
1141
|
|
|
|
|
|
|
&& $self->plugins->[0]->_add_postponed_plugin_hooks( |
1142
|
|
|
|
|
|
|
$self->postponed_hooks |
1143
|
|
|
|
|
|
|
); |
1144
|
|
|
|
|
|
|
|
1145
|
205
|
|
|
|
|
3381
|
foreach my $prep_cb ( @{ $self->prep_apps } ) { |
|
205
|
|
|
|
|
1216
|
|
1146
|
4
|
|
|
|
|
15
|
$prep_cb->($self); |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
sub init_route_handlers { |
1151
|
237
|
|
|
237
|
0
|
613
|
my $self = shift; |
1152
|
|
|
|
|
|
|
|
1153
|
237
|
|
|
|
|
4550
|
my $handlers_config = $self->config->{route_handlers}; |
1154
|
236
|
|
|
|
|
8706
|
for my $handler_data ( @{$handlers_config} ) { |
|
236
|
|
|
|
|
864
|
|
1155
|
235
|
|
|
|
|
533
|
my ($handler_name, $config) = @{$handler_data}; |
|
235
|
|
|
|
|
694
|
|
1156
|
235
|
50
|
|
|
|
1149
|
$config = {} if !is_ref($config); |
1157
|
|
|
|
|
|
|
|
1158
|
235
|
|
|
|
|
5019
|
my $handler = $self->_factory->create( |
1159
|
|
|
|
|
|
|
Handler => $handler_name, |
1160
|
|
|
|
|
|
|
app => $self, |
1161
|
|
|
|
|
|
|
%$config, |
1162
|
|
|
|
|
|
|
postponed_hooks => $self->postponed_hooks, |
1163
|
|
|
|
|
|
|
); |
1164
|
|
|
|
|
|
|
|
1165
|
235
|
|
|
|
|
251977
|
push @{ $self->route_handlers }, { |
|
235
|
|
|
|
|
5597
|
|
1166
|
|
|
|
|
|
|
name => $handler_name, |
1167
|
|
|
|
|
|
|
handler => $handler, |
1168
|
|
|
|
|
|
|
}; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
} |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
sub register_route_handlers { |
1173
|
205
|
|
|
205
|
0
|
575
|
my $self = shift; |
1174
|
205
|
|
|
|
|
492
|
for my $handler ( @{$self->route_handlers} ) { |
|
205
|
|
|
|
|
4561
|
|
1175
|
203
|
|
|
|
|
2972
|
my $handler_code = $handler->{handler}; |
1176
|
203
|
|
|
|
|
1580
|
$handler_code->register($self); |
1177
|
|
|
|
|
|
|
} |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
sub compile_hooks { |
1181
|
208
|
|
|
208
|
0
|
656
|
my ($self) = @_; |
1182
|
|
|
|
|
|
|
|
1183
|
208
|
|
|
|
|
991
|
for my $position ( $self->supported_hooks ) { |
1184
|
1664
|
|
|
|
|
11032
|
my $compiled_hooks = []; |
1185
|
1664
|
|
|
|
|
2380
|
for my $hook ( @{ $self->hooks->{$position} } ) { |
|
1664
|
|
|
|
|
25186
|
|
1186
|
250
|
|
|
|
|
3713
|
Scalar::Util::weaken( my $app = $self ); |
1187
|
|
|
|
|
|
|
my $compiled = sub { |
1188
|
|
|
|
|
|
|
# don't run the filter if halt has been used |
1189
|
681
|
100
|
66
|
681
|
|
2680
|
$Dancer2::Core::Route::RESPONSE && |
1190
|
|
|
|
|
|
|
$Dancer2::Core::Route::RESPONSE->is_halted |
1191
|
|
|
|
|
|
|
and return; |
1192
|
|
|
|
|
|
|
|
1193
|
680
|
|
|
|
|
2428
|
eval { $EVAL_SHIM->($hook,@_); 1; } |
|
671
|
|
|
|
|
3450
|
|
1194
|
680
|
100
|
|
|
|
5679
|
or do { |
1195
|
4
|
|
50
|
|
|
176
|
my $err = $@ || "Zombie Error"; |
1196
|
4
|
|
|
|
|
24
|
$app->cleanup; |
1197
|
4
|
|
|
|
|
61
|
$app->log('error', "Exception caught in '$position' filter: $err"); |
1198
|
4
|
|
|
|
|
437
|
croak "Exception caught in '$position' filter: $err"; |
1199
|
|
|
|
|
|
|
}; |
1200
|
250
|
|
|
|
|
1600
|
}; |
1201
|
|
|
|
|
|
|
|
1202
|
250
|
|
|
|
|
546
|
push @{$compiled_hooks}, $compiled; |
|
250
|
|
|
|
|
844
|
|
1203
|
|
|
|
|
|
|
} |
1204
|
1664
|
|
|
|
|
13945
|
$self->replace_hook( $position, $compiled_hooks ); |
1205
|
|
|
|
|
|
|
} |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
sub lexical_prefix { |
1209
|
5
|
|
|
5
|
1
|
1313
|
my $self = shift; |
1210
|
5
|
|
|
|
|
14
|
my $prefix = shift; |
1211
|
5
|
|
|
|
|
10
|
my $cb = shift; |
1212
|
|
|
|
|
|
|
|
1213
|
5
|
100
|
|
|
|
20
|
$prefix eq '/' and undef $prefix; |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
# save the app prefix |
1216
|
5
|
|
|
|
|
99
|
my $app_prefix = $self->prefix; |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
# alter the prefix for the callback |
1219
|
5
|
100
|
|
|
|
55
|
my $new_prefix = |
|
|
100
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
( defined $app_prefix ? $app_prefix : '' ) |
1221
|
|
|
|
|
|
|
. ( defined $prefix ? $prefix : '' ); |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
# if the new prefix is empty, it's a meaningless prefix, just ignore it |
1224
|
5
|
100
|
|
|
|
79
|
length $new_prefix and $self->prefix($new_prefix); |
1225
|
|
|
|
|
|
|
|
1226
|
5
|
|
|
|
|
120
|
my $err; |
1227
|
5
|
|
|
|
|
72
|
my $ok= eval { $EVAL_SHIM->($cb); 1 } |
|
4
|
|
|
|
|
20
|
|
1228
|
5
|
100
|
50
|
|
|
22
|
or do { $err = $@ || "Zombie Error"; }; |
|
1
|
|
|
|
|
21
|
|
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
# restore app prefix |
1231
|
5
|
|
|
|
|
89
|
$self->prefix($app_prefix); |
1232
|
|
|
|
|
|
|
|
1233
|
5
|
100
|
|
|
|
411
|
$ok or croak "Unable to run the callback for prefix '$prefix': $err"; |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
sub add_route { |
1237
|
617
|
|
|
617
|
1
|
1795
|
my $self = shift; |
1238
|
617
|
|
|
|
|
2431
|
my %route_attrs = @_; |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
my $route = Dancer2::Core::Route->new( |
1241
|
|
|
|
|
|
|
type_library => $self->config->{type_library}, |
1242
|
617
|
|
|
|
|
12190
|
prefix => $self->prefix, |
1243
|
|
|
|
|
|
|
%route_attrs, |
1244
|
|
|
|
|
|
|
); |
1245
|
|
|
|
|
|
|
|
1246
|
617
|
|
|
|
|
54164
|
my $method = $route->method; |
1247
|
|
|
|
|
|
|
|
1248
|
617
|
|
|
|
|
1230
|
push @{ $self->routes->{$method} }, $route; |
|
617
|
|
|
|
|
11303
|
|
1249
|
|
|
|
|
|
|
|
1250
|
617
|
|
|
|
|
9235
|
return $route; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
sub route_exists { |
1254
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1255
|
0
|
|
|
|
|
0
|
my $route = shift; |
1256
|
|
|
|
|
|
|
|
1257
|
0
|
|
|
|
|
0
|
my $routes = $self->routes->{ $route->method }; |
1258
|
|
|
|
|
|
|
|
1259
|
0
|
|
|
|
|
0
|
foreach my $existing_route (@$routes) { |
1260
|
0
|
0
|
|
|
|
0
|
$existing_route->spec_route eq $route->spec_route |
1261
|
|
|
|
|
|
|
and return 1; |
1262
|
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
|
1264
|
0
|
|
|
|
|
0
|
return 0; |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
sub routes_regexps_for { |
1268
|
1
|
|
|
1
|
1
|
684
|
my $self = shift; |
1269
|
1
|
|
|
|
|
3
|
my $method = shift; |
1270
|
|
|
|
|
|
|
|
1271
|
1
|
|
|
|
|
2
|
return [ map $_->regexp, @{ $self->routes->{$method} } ]; |
|
1
|
|
|
|
|
24
|
|
1272
|
|
|
|
|
|
|
} |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
sub cookie { |
1275
|
548
|
|
|
548
|
0
|
1093
|
my $self = shift; |
1276
|
|
|
|
|
|
|
|
1277
|
548
|
50
|
|
|
|
3179
|
@_ == 1 and return $self->request->cookies->{ $_[0] }; |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
# writer |
1280
|
0
|
|
|
|
|
0
|
my ( $name, $value, %options ) = @_; |
1281
|
0
|
|
|
|
|
0
|
my $c = |
1282
|
|
|
|
|
|
|
Dancer2::Core::Cookie->new( name => $name, value => $value, %options ); |
1283
|
0
|
|
|
|
|
0
|
$self->response->push_header( 'Set-Cookie' => $c->to_header ); |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
sub redirect { |
1287
|
26
|
|
|
26
|
1
|
62
|
my $self = shift; |
1288
|
26
|
|
|
|
|
52
|
my $destination = shift; |
1289
|
26
|
|
|
|
|
50
|
my $status = shift; |
1290
|
|
|
|
|
|
|
|
1291
|
26
|
100
|
|
|
|
100
|
if ($destination =~ m{^/(?!/)}) { |
1292
|
|
|
|
|
|
|
# If the app is mounted to something other than "/", we must |
1293
|
|
|
|
|
|
|
# preserve its path. |
1294
|
12
|
|
|
|
|
95
|
my $script_name = $self->request->script_name; |
1295
|
12
|
|
|
|
|
102
|
$script_name =~ s{/$}{}; # Remove trailing slash (if present). |
1296
|
12
|
|
|
|
|
35
|
$destination = $script_name . $destination; |
1297
|
|
|
|
|
|
|
} |
1298
|
|
|
|
|
|
|
|
1299
|
26
|
|
|
|
|
452
|
$self->response->redirect( $destination, $status ); |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
# Short circuit any remaining before hook / route code |
1302
|
|
|
|
|
|
|
# ('pass' and after hooks are still processed) |
1303
|
26
|
50
|
|
|
|
3892
|
$self->has_with_return |
1304
|
|
|
|
|
|
|
and $self->with_return->($self->response); |
1305
|
|
|
|
|
|
|
} |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
sub halt { |
1308
|
7
|
|
|
7
|
1
|
10
|
my $self = shift; |
1309
|
7
|
|
|
|
|
136
|
$self->response->halt( @_ ); |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
# Short citcuit any remaining hook/route code |
1312
|
7
|
50
|
|
|
|
336
|
$self->has_with_return |
1313
|
|
|
|
|
|
|
and $self->with_return->($self->response); |
1314
|
|
|
|
|
|
|
} |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
sub pass { |
1317
|
2
|
|
|
2
|
1
|
6
|
my $self = shift; |
1318
|
2
|
|
|
|
|
39
|
$self->response->pass; |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
# Short citcuit any remaining hook/route code |
1321
|
2
|
50
|
|
|
|
104
|
$self->has_with_return |
1322
|
|
|
|
|
|
|
and $self->with_return->($self->response); |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
sub forward { |
1326
|
44
|
|
|
44
|
1
|
91
|
my $self = shift; |
1327
|
44
|
|
|
|
|
97
|
my $url = shift; |
1328
|
44
|
|
|
|
|
85
|
my $params = shift; |
1329
|
44
|
|
|
|
|
72
|
my $options = shift; |
1330
|
|
|
|
|
|
|
|
1331
|
44
|
|
|
|
|
165
|
my $new_request = $self->make_forward_to( $url, $params, $options ); |
1332
|
|
|
|
|
|
|
|
1333
|
44
|
50
|
|
|
|
278
|
$self->has_with_return |
1334
|
|
|
|
|
|
|
and $self->with_return->($new_request); |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
# nothing else will run after this |
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
# Create a new request which is a clone of the current one, apart |
1340
|
|
|
|
|
|
|
# from the path location, which points instead to the new location |
1341
|
|
|
|
|
|
|
sub make_forward_to { |
1342
|
53
|
|
|
53
|
0
|
196
|
my $self = shift; |
1343
|
53
|
|
|
|
|
96
|
my $url = shift; |
1344
|
53
|
|
|
|
|
100
|
my $params = shift; |
1345
|
53
|
|
|
|
|
82
|
my $options = shift; |
1346
|
|
|
|
|
|
|
|
1347
|
53
|
|
|
|
|
156
|
my $overrides = { PATH_INFO => $url }; |
1348
|
|
|
|
|
|
|
exists $options->{method} and |
1349
|
53
|
100
|
|
|
|
186
|
$overrides->{REQUEST_METHOD} = $options->{method}; |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
# "clone" the existing request |
1352
|
53
|
|
|
|
|
263
|
my $new_request = $self->request->_shallow_clone( $params, $overrides ); |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
# If a session object was created during processing of the original request |
1355
|
|
|
|
|
|
|
# i.e. a session object exists but no cookie existed |
1356
|
|
|
|
|
|
|
# add a cookie so the dispatcher can assign the session to the appropriate app |
1357
|
53
|
|
|
|
|
1242
|
my $engine = $self->session_engine; |
1358
|
53
|
100
|
66
|
|
|
1591
|
$engine && $self->_has_session or return $new_request; |
1359
|
11
|
|
|
|
|
38
|
my $name = $engine->cookie_name; |
1360
|
11
|
100
|
|
|
|
26
|
exists $new_request->cookies->{$name} and return $new_request; |
1361
|
10
|
|
|
|
|
207
|
$new_request->cookies->{$name} = |
1362
|
|
|
|
|
|
|
Dancer2::Core::Cookie->new( name => $name, value => $self->session->id ); |
1363
|
|
|
|
|
|
|
|
1364
|
10
|
|
|
|
|
34
|
return $new_request; |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
|
1367
|
1
|
|
|
1
|
1
|
1996
|
sub app { shift } |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
# DISPATCHER |
1370
|
|
|
|
|
|
|
sub to_app { |
1371
|
203
|
|
|
203
|
0
|
1039
|
my $self = shift; |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
# build engines |
1374
|
|
|
|
|
|
|
{ |
1375
|
203
|
|
|
|
|
475
|
for ( qw<logger session template> ) { |
|
203
|
|
|
|
|
731
|
|
1376
|
609
|
|
|
|
|
19904
|
my $attr = "${_}_engine"; |
1377
|
609
|
|
|
|
|
12564
|
$self->$attr; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
# the serializer engine does not have a default |
1381
|
|
|
|
|
|
|
# and is the only engine that can actually not have a value |
1382
|
203
|
100
|
|
|
|
18686
|
if ( $self->config->{'serializer'} ) { |
1383
|
21
|
|
|
|
|
759
|
$self->serializer_engine; |
1384
|
|
|
|
|
|
|
} |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
203
|
|
|
|
|
3534
|
$self->finish; |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
my $psgi = sub { |
1390
|
597
|
|
|
597
|
|
1333374
|
my $env = shift; |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
# pre-request sanity check |
1393
|
597
|
|
|
|
|
1932
|
my $method = uc $env->{'REQUEST_METHOD'}; |
1394
|
597
|
100
|
|
|
|
2483
|
$Dancer2::Core::Types::supported_http_methods{$method} |
1395
|
|
|
|
|
|
|
or return [ |
1396
|
|
|
|
|
|
|
405, |
1397
|
|
|
|
|
|
|
[ 'Content-Type' => 'text/plain' ], |
1398
|
|
|
|
|
|
|
[ "Method Not Allowed\n\n$method is not supported." ] |
1399
|
|
|
|
|
|
|
]; |
1400
|
|
|
|
|
|
|
|
1401
|
595
|
|
|
|
|
1010
|
my $response; |
1402
|
|
|
|
|
|
|
eval { |
1403
|
595
|
|
|
|
|
4263
|
$EVAL_SHIM->(sub{ $response = $self->dispatch($env)->to_psgi }); |
|
595
|
|
|
|
|
2085
|
|
1404
|
595
|
|
|
|
|
5284
|
1; |
1405
|
595
|
50
|
|
|
|
1089
|
} or do { |
1406
|
0
|
|
0
|
|
|
0
|
my $err = $@ || "Zombie Error"; |
1407
|
|
|
|
|
|
|
return [ |
1408
|
0
|
|
|
|
|
0
|
500, |
1409
|
|
|
|
|
|
|
[ 'Content-Type' => 'text/plain' ], |
1410
|
|
|
|
|
|
|
[ "Internal Server Error\n\n$err" ], |
1411
|
|
|
|
|
|
|
]; |
1412
|
|
|
|
|
|
|
}; |
1413
|
|
|
|
|
|
|
|
1414
|
595
|
|
|
|
|
6540
|
return $response; |
1415
|
203
|
|
|
|
|
1298
|
}; |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
# Only add static content handler if required |
1418
|
203
|
100
|
|
|
|
3705
|
if ( $self->config->{'static_handler'} ) { |
1419
|
|
|
|
|
|
|
# Use App::File to "serve" the static content |
1420
|
|
|
|
|
|
|
my $static_app = Plack::App::File->new( |
1421
|
|
|
|
|
|
|
root => $self->config->{public_dir}, |
1422
|
8
|
|
|
8
|
|
1925
|
content_type => sub { $self->mime_type->for_file( $_[0] ) }, |
1423
|
112
|
|
|
|
|
2929
|
)->to_app; |
1424
|
|
|
|
|
|
|
# Conditionally use the static handler wrapped with ConditionalGET |
1425
|
|
|
|
|
|
|
# when the file exists. Otherwise the request passes into our app. |
1426
|
|
|
|
|
|
|
$psgi = Plack::Middleware::Conditional->wrap( |
1427
|
|
|
|
|
|
|
$psgi, |
1428
|
429
|
|
|
429
|
|
2132270
|
condition => sub { -f path( $self->config->{public_dir}, shift->{PATH_INFO} ) }, |
1429
|
112
|
|
|
112
|
|
9135
|
builder => sub { Plack::Middleware::ConditionalGET->wrap( $static_app ) }, |
1430
|
112
|
|
|
|
|
7280
|
); |
1431
|
|
|
|
|
|
|
} |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
# Wrap with common middleware |
1434
|
203
|
100
|
|
|
|
9430
|
if ( ! $self->config->{'no_default_middleware'} ) { |
1435
|
|
|
|
|
|
|
# FixMissingBodyInRedirect |
1436
|
199
|
|
|
|
|
4073
|
$psgi = Plack::Middleware::FixMissingBodyInRedirect->wrap( $psgi ); |
1437
|
|
|
|
|
|
|
# Apply Head. After static so a HEAD request on static content DWIM. |
1438
|
199
|
|
|
|
|
9779
|
$psgi = Plack::Middleware::Head->wrap( $psgi ); |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
203
|
|
|
|
|
8757
|
return $psgi; |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
sub dispatch { |
1445
|
595
|
|
|
595
|
0
|
1093
|
my $self = shift; |
1446
|
595
|
|
|
|
|
1020
|
my $env = shift; |
1447
|
|
|
|
|
|
|
|
1448
|
595
|
|
|
|
|
2165
|
my $runner = Dancer2::runner(); |
1449
|
595
|
|
|
|
|
1090
|
my $request; |
1450
|
595
|
|
|
|
|
1019
|
my $request_built_successfully = eval { |
1451
|
|
|
|
|
|
|
$EVAL_SHIM->(sub { |
1452
|
595
|
|
100
|
595
|
|
4226
|
$request = $runner->{'internal_request'} || $self->build_request($env); |
1453
|
595
|
|
|
|
|
2997
|
}); |
1454
|
591
|
|
|
|
|
2784
|
1; |
1455
|
|
|
|
|
|
|
}; |
1456
|
|
|
|
|
|
|
# Catch bad content causing deserialization to fail when building the request |
1457
|
595
|
100
|
|
|
|
2396
|
if ( ! $request_built_successfully ) { |
1458
|
4
|
|
|
|
|
12
|
my $err = $@; |
1459
|
4
|
|
|
|
|
23
|
Scalar::Util::weaken(my $app = $self); |
1460
|
4
|
|
|
|
|
47
|
return Dancer2::Core::Error->new( |
1461
|
|
|
|
|
|
|
app => $app, |
1462
|
|
|
|
|
|
|
message => $err, |
1463
|
|
|
|
|
|
|
status => 400, # 400 Bad request (dont send again), rather than 500 |
1464
|
|
|
|
|
|
|
)->throw; |
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
|
1467
|
591
|
|
|
|
|
14591
|
my $cname = $self->session_engine->cookie_name; |
1468
|
591
|
|
|
|
|
7617
|
my $defined_engines = $self->defined_engines; |
1469
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
DISPATCH: |
1471
|
591
|
|
|
|
|
30645
|
while (1) { |
1472
|
618
|
|
|
|
|
2773
|
my $http_method = lc $request->method; |
1473
|
618
|
|
|
|
|
5291
|
my $path_info = $request->path_info; |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
# Add request to app and engines |
1476
|
618
|
|
|
|
|
4685
|
$self->set_request($request, $defined_engines); |
1477
|
|
|
|
|
|
|
|
1478
|
618
|
|
|
|
|
68628
|
$self->log( core => "looking for $http_method $path_info" ); |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
ROUTE: |
1481
|
618
|
|
|
|
|
1320
|
foreach my $route ( @{ $self->routes->{$http_method} } ) { |
|
618
|
|
|
|
|
10512
|
|
1482
|
|
|
|
|
|
|
#warn "testing route " . $route->regexp . "\n"; |
1483
|
|
|
|
|
|
|
# TODO store in route cache |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
# go to the next route if no match |
1486
|
1278
|
100
|
|
|
|
8685
|
my $match = $route->match($request) |
1487
|
|
|
|
|
|
|
or next ROUTE; |
1488
|
|
|
|
|
|
|
|
1489
|
554
|
|
|
|
|
19301
|
$request->_set_route_params($match); |
1490
|
554
|
|
|
|
|
2431
|
$request->_set_route_parameters($match); |
1491
|
554
|
|
|
|
|
22000
|
$request->_set_route($route); |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
# Add session to app *if* we have a session and the request |
1494
|
|
|
|
|
|
|
# has the appropriate cookie header for _this_ app. |
1495
|
554
|
100
|
|
|
|
1988
|
if ( my $sess = $runner->{'internal_sessions'}{$cname} ) { |
1496
|
6
|
|
|
|
|
130
|
$self->set_session($sess); |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
# calling the actual route |
1500
|
554
|
|
|
|
|
1155
|
my $response; |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
# this is very evil, but allows breaking out of multiple stack |
1503
|
|
|
|
|
|
|
# frames without throwing an exception. Avoiding exceptions means |
1504
|
|
|
|
|
|
|
# a naive eval won't swallow our flow control mechanisms, and |
1505
|
|
|
|
|
|
|
# avoids __DIE__ handlers. It also prevents some cleanup routines |
1506
|
|
|
|
|
|
|
# from working, since they are expecting control to return to them |
1507
|
|
|
|
|
|
|
# after an eval. |
1508
|
|
|
|
|
|
|
DANCER2_CORE_APP_ROUTE_RETURN: { |
1509
|
554
|
50
|
|
|
|
964
|
if (!$self->has_with_return) { |
|
554
|
|
|
|
|
2294
|
|
1510
|
|
|
|
|
|
|
$self->set_with_return(sub { |
1511
|
103
|
|
|
103
|
|
458
|
$response = shift; |
1512
|
145
|
|
|
145
|
|
1496
|
no warnings 'exiting'; |
|
145
|
|
|
|
|
443
|
|
|
145
|
|
|
|
|
134669
|
|
1513
|
103
|
|
|
|
|
648
|
last DANCER2_CORE_APP_ROUTE_RETURN; |
1514
|
554
|
|
|
|
|
3562
|
}); |
1515
|
|
|
|
|
|
|
} |
1516
|
554
|
|
|
|
|
1904
|
$response = $self->_dispatch_route($route); |
1517
|
|
|
|
|
|
|
}; |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
# ensure we clear the with_return handler |
1520
|
554
|
|
|
|
|
11526
|
$self->clear_with_return; |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
# handle forward requests |
1523
|
554
|
100
|
|
|
|
5642
|
if ( ref $response eq 'Dancer2::Core::Request' ) { |
1524
|
|
|
|
|
|
|
# this is actually a request, not response |
1525
|
|
|
|
|
|
|
# however, we need to clean up the request & response |
1526
|
44
|
|
|
|
|
802
|
$self->clear_request; |
1527
|
44
|
|
|
|
|
903
|
$self->clear_response; |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
# this is in case we're asked for an old-style dispatching |
1530
|
44
|
100
|
|
|
|
462
|
if ( $runner->{'internal_dispatch'} ) { |
1531
|
|
|
|
|
|
|
# Get the session object from the app before we clean up |
1532
|
|
|
|
|
|
|
# the request context, so we can propagate this to the |
1533
|
|
|
|
|
|
|
# next dispatch cycle (if required). |
1534
|
|
|
|
|
|
|
$self->_has_session |
1535
|
17
|
100
|
|
|
|
176
|
and $runner->{'internal_sessions'}{$cname} = |
1536
|
|
|
|
|
|
|
$self->session; |
1537
|
|
|
|
|
|
|
|
1538
|
17
|
|
|
|
|
93
|
$runner->{'internal_forward'} = 1; |
1539
|
17
|
|
|
|
|
39
|
$runner->{'internal_request'} = $response; |
1540
|
17
|
|
|
|
|
46
|
return $self->response_not_found($request); |
1541
|
|
|
|
|
|
|
} |
1542
|
|
|
|
|
|
|
|
1543
|
27
|
|
|
|
|
65
|
$request = $response; |
1544
|
27
|
|
|
|
|
79
|
next DISPATCH; |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
# from here we assume the response is a Dancer2::Core::Response |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
# halted response, don't process further |
1550
|
510
|
100
|
|
|
|
8615
|
if ( $response->is_halted ) { |
1551
|
34
|
|
|
|
|
413
|
$self->cleanup; |
1552
|
34
|
|
|
|
|
559
|
delete $runner->{'internal_request'}; |
1553
|
34
|
|
|
|
|
2339
|
return $response; |
1554
|
|
|
|
|
|
|
} |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
# pass the baton if the response says so... |
1557
|
476
|
100
|
|
|
|
10524
|
if ( $response->has_passed ) { |
1558
|
|
|
|
|
|
|
## A previous route might have used splat, failed |
1559
|
|
|
|
|
|
|
## this needs to be cleaned from the request. |
1560
|
|
|
|
|
|
|
exists $request->{_params}{splat} |
1561
|
9
|
100
|
|
|
|
91
|
and delete $request->{_params}{splat}; |
1562
|
|
|
|
|
|
|
|
1563
|
9
|
|
|
|
|
145
|
$response->has_passed(0); # clear for the next round |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
# clear the content because if you pass it, |
1566
|
|
|
|
|
|
|
# the next route is in charge of catching it |
1567
|
9
|
|
|
|
|
357
|
$response->clear_content; |
1568
|
9
|
|
|
|
|
59
|
next ROUTE; |
1569
|
|
|
|
|
|
|
} |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
# it's just a regular response |
1572
|
467
|
|
|
|
|
14510
|
$self->execute_hook( 'core.app.after_request', $response ); |
1573
|
467
|
|
|
|
|
1852
|
$self->cleanup; |
1574
|
467
|
|
|
|
|
3047
|
delete $runner->{'internal_request'}; |
1575
|
|
|
|
|
|
|
|
1576
|
467
|
|
|
|
|
5074
|
return $response; |
1577
|
|
|
|
|
|
|
} |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
# we don't actually want to continue the loop |
1580
|
73
|
|
|
|
|
219
|
last; |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
# No response! ensure Core::Dispatcher recognizes this failure |
1584
|
|
|
|
|
|
|
# so it can try the next Core::App |
1585
|
|
|
|
|
|
|
# and set the created request so we don't create it again |
1586
|
|
|
|
|
|
|
# (this is important so we don't ignore the previous body) |
1587
|
73
|
100
|
|
|
|
243
|
if ( $runner->{'internal_dispatch'} ) { |
1588
|
51
|
|
|
|
|
127
|
$runner->{'internal_404'} = 1; |
1589
|
51
|
|
|
|
|
128
|
$runner->{'internal_request'} = $request; |
1590
|
|
|
|
|
|
|
} |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
# Render 404 response, cleanup, and return the response. |
1593
|
73
|
|
|
|
|
237
|
my $response = $self->response_not_found($request); |
1594
|
73
|
|
|
|
|
240
|
$self->cleanup; |
1595
|
73
|
|
|
|
|
730
|
return $response; |
1596
|
|
|
|
|
|
|
} |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
sub build_request { |
1599
|
546
|
|
|
546
|
0
|
1451
|
my ( $self, $env ) = @_; |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
# If we have an app, send the serialization engine |
1602
|
|
|
|
|
|
|
my $request = Dancer2::Core::Request->new( |
1603
|
|
|
|
|
|
|
env => $env, |
1604
|
546
|
100
|
100
|
|
|
1919
|
is_behind_proxy => $self->settings->{'behind_proxy'} || 0, |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
$self->has_serializer_engine |
1607
|
|
|
|
|
|
|
? ( serializer => $self->serializer_engine ) |
1608
|
|
|
|
|
|
|
: (), |
1609
|
|
|
|
|
|
|
); |
1610
|
|
|
|
|
|
|
|
1611
|
542
|
|
|
|
|
3352
|
return $request; |
1612
|
|
|
|
|
|
|
} |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
# Call any before hooks then the matched route. |
1615
|
|
|
|
|
|
|
sub _dispatch_route { |
1616
|
554
|
|
|
554
|
|
1283
|
my ( $self, $route ) = @_; |
1617
|
|
|
|
|
|
|
|
1618
|
554
|
|
|
|
|
1044
|
local $@; |
1619
|
|
|
|
|
|
|
eval { |
1620
|
|
|
|
|
|
|
$EVAL_SHIM->(sub { |
1621
|
554
|
|
|
554
|
|
14839
|
$self->execute_hook( 'core.app.before_request', $self ); |
1622
|
554
|
|
|
|
|
4244
|
}); |
1623
|
545
|
|
|
|
|
7756
|
1; |
1624
|
554
|
100
|
|
|
|
1137
|
} or do { |
1625
|
4
|
|
50
|
|
|
162
|
my $err = $@ || "Zombie Error"; |
1626
|
4
|
|
|
|
|
26
|
return $self->response_internal_error($err); |
1627
|
|
|
|
|
|
|
}; |
1628
|
545
|
|
|
|
|
9277
|
my $response = $self->response; |
1629
|
|
|
|
|
|
|
|
1630
|
545
|
100
|
|
|
|
12354
|
if ( $response->is_halted ) { |
1631
|
2
|
|
|
|
|
25
|
return $self->_prep_response( $response ); |
1632
|
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
eval { |
1635
|
543
|
|
|
543
|
|
3256
|
$EVAL_SHIM->(sub{ $response = $route->execute($self) }); |
|
543
|
|
|
|
|
5845
|
|
1636
|
432
|
|
|
|
|
2274
|
1; |
1637
|
543
|
100
|
|
|
|
4550
|
} or do { |
1638
|
13
|
|
50
|
|
|
717
|
my $err = $@ || "Zombie Error"; |
1639
|
13
|
|
|
|
|
69
|
return $self->response_internal_error($err); |
1640
|
|
|
|
|
|
|
}; |
1641
|
|
|
|
|
|
|
|
1642
|
432
|
|
|
|
|
2844
|
return $response; |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
sub _prep_response { |
1646
|
455
|
|
|
455
|
|
1295
|
my ( $self, $response, $content ) = @_; |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
# The response object has no back references to the content or app |
1649
|
|
|
|
|
|
|
# Update the default_content_type of the response if any value set in |
1650
|
|
|
|
|
|
|
# config so it can be applied when the response is encoded/returned. |
1651
|
455
|
|
|
|
|
10204
|
my $config = $self->config; |
1652
|
455
|
50
|
33
|
|
|
5891
|
if ( exists $config->{content_type} |
1653
|
|
|
|
|
|
|
and my $ct = $config->{content_type} ) { |
1654
|
455
|
|
|
|
|
8121
|
$response->default_content_type($ct); |
1655
|
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
# if we were passed any content, set it in the response |
1658
|
455
|
100
|
|
|
|
22935
|
defined $content && $response->content($content); |
1659
|
455
|
|
|
|
|
47368
|
return $response; |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
sub response_internal_error { |
1663
|
17
|
|
|
17
|
0
|
64
|
my ( $self, $error ) = @_; |
1664
|
|
|
|
|
|
|
|
1665
|
17
|
|
|
|
|
514
|
$self->execute_hook( 'core.app.route_exception', $self, $error ); |
1666
|
17
|
|
|
|
|
267
|
$self->log( error => "Route exception: $error" ); |
1667
|
|
|
|
|
|
|
|
1668
|
17
|
|
|
|
|
285
|
local $Dancer2::Core::Route::REQUEST = $self->request; |
1669
|
17
|
|
|
|
|
329
|
local $Dancer2::Core::Route::RESPONSE = $self->response; |
1670
|
|
|
|
|
|
|
|
1671
|
17
|
|
|
|
|
418
|
return Dancer2::Core::Error->new( |
1672
|
|
|
|
|
|
|
app => $self, |
1673
|
|
|
|
|
|
|
status => 500, |
1674
|
|
|
|
|
|
|
exception => $error, |
1675
|
|
|
|
|
|
|
)->throw; |
1676
|
|
|
|
|
|
|
} |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
sub response_not_found { |
1679
|
99
|
|
|
99
|
0
|
238
|
my ( $self, $request ) = @_; |
1680
|
|
|
|
|
|
|
|
1681
|
99
|
|
|
|
|
281
|
$self->set_request($request); |
1682
|
|
|
|
|
|
|
|
1683
|
99
|
|
|
|
|
9438
|
local $Dancer2::Core::Route::REQUEST = $self->request; |
1684
|
99
|
|
|
|
|
1743
|
local $Dancer2::Core::Route::RESPONSE = $self->response; |
1685
|
|
|
|
|
|
|
|
1686
|
99
|
|
|
|
|
7245
|
my $response = Dancer2::Core::Error->new( |
1687
|
|
|
|
|
|
|
app => $self, |
1688
|
|
|
|
|
|
|
status => 404, |
1689
|
|
|
|
|
|
|
message => $request->path, |
1690
|
|
|
|
|
|
|
)->throw; |
1691
|
|
|
|
|
|
|
|
1692
|
99
|
|
|
|
|
1215
|
$self->cleanup; |
1693
|
|
|
|
|
|
|
|
1694
|
99
|
|
|
|
|
905
|
return $response; |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
1; |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
__END__ |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
=pod |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
=encoding UTF-8 |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
=head1 NAME |
1706
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
Dancer2::Core::App - encapsulation of Dancer2 packages |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
=head1 VERSION |
1710
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
version 1.0.0 |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
Everything a package that uses Dancer2 does is encapsulated into a |
1716
|
|
|
|
|
|
|
C<Dancer2::Core::App> instance. This class defines all that can be done in such |
1717
|
|
|
|
|
|
|
objects. |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
Mainly, it will contain all the route handlers, the configuration settings and |
1720
|
|
|
|
|
|
|
the hooks that are defined in the calling package. |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
Note that with Dancer2, everything that is done within a package is scoped to |
1723
|
|
|
|
|
|
|
that package, thanks to that encapsulation. |
1724
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
=head2 plugins |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
=head2 runner_config |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
=head2 default_config |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
=head2 with_return |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
Used to cache the coderef that will return from back to the dispatcher, across |
1736
|
|
|
|
|
|
|
an arbitrary number of stack frames. |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
=head2 destroyed_session |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
We cache a destroyed session here; once this is set we must not attempt to |
1741
|
|
|
|
|
|
|
retrieve the session from the cookie in the request. If no new session is |
1742
|
|
|
|
|
|
|
created, this is set (with expiration) as a cookie to force the browser to |
1743
|
|
|
|
|
|
|
expire the cookie. |
1744
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=head1 METHODS |
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
=head2 has_session |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
Returns true if session engine has been defined and if either a session |
1750
|
|
|
|
|
|
|
object has been instantiated or if a session cookie was found and not |
1751
|
|
|
|
|
|
|
subsequently invalidated. |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
=head2 change_session_id |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
Changes the session ID used by the current session. This should be used on |
1756
|
|
|
|
|
|
|
any change of privilege level, for example on login. Returns the new session |
1757
|
|
|
|
|
|
|
ID. |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
=head2 destroy_session |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
Destroys the current session and ensures any subsequent session is created |
1762
|
|
|
|
|
|
|
from scratch and not from the request session cookie |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
=head2 register_plugin |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
=head2 with_plugins( @plugin_names ) |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
Creates instances of the given plugins and tie them to the app. |
1769
|
|
|
|
|
|
|
The plugin classes are automatically loaded. |
1770
|
|
|
|
|
|
|
Returns the newly created plugins. |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
The plugin names are expected to be without the leading C<Dancer2::Plugin>. |
1773
|
|
|
|
|
|
|
I.e., use C<Foo> to mean C<Dancer2::Plugin::Foo>. |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
If a given plugin is already tied to the app, the already-existing |
1776
|
|
|
|
|
|
|
instance will be used and returned by C<with_plugins> (think of it |
1777
|
|
|
|
|
|
|
as using a role). |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
my @plugins = $app->with_plugins( 'Foo', 'Bar' ); |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
# now $app uses the plugins Dancer2::Plugin::Foo |
1782
|
|
|
|
|
|
|
# and Dancer2::Plugin::Bar |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
=head2 with_plugin( $plugin_name ) |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
Just like C<with_plugin>, but for a single plugin. |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
my $plugin = $app->with_plugin('Foo'); |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=head2 add_route |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
Register a new route handler. |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
$app->add_route( |
1795
|
|
|
|
|
|
|
method => 'get', |
1796
|
|
|
|
|
|
|
regexp => '/somewhere', |
1797
|
|
|
|
|
|
|
code => sub { ... }, |
1798
|
|
|
|
|
|
|
options => $conditions, |
1799
|
|
|
|
|
|
|
); |
1800
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
Returns a new L<< Dancer2::Core::Route >> object created with the passed |
1802
|
|
|
|
|
|
|
arguments. |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
=head2 route_exists |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
Returns a true value if a route already exists, otherwise false. |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
my $route = Dancer2::Core::Route->new(...); |
1809
|
|
|
|
|
|
|
if ($app->route_exists($route)) { |
1810
|
|
|
|
|
|
|
... |
1811
|
|
|
|
|
|
|
} |
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
=head2 routes_regexps_for |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
Sugar for getting the ordered list of all registered route regexps by method. |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
my $regexps = $app->routes_regexps_for( 'get' ); |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
Returns an ArrayRef with the results. |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
=head2 redirect($destination, $status) |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
Sets a redirect in the response object. If $destination is not an absolute URI, then it will |
1824
|
|
|
|
|
|
|
be made into an absolute URI, relative to the URI in the request. |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
=head2 halt |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
Flag the response object as 'halted'. |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
If called during request dispatch, immediately returns the response |
1831
|
|
|
|
|
|
|
to the dispatcher and after hooks will not be run. |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
=head2 pass |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
Flag the response object as 'passed'. |
1836
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
If called during request dispatch, immediately returns the response |
1838
|
|
|
|
|
|
|
to the dispatcher. |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
=head2 forward |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
Create a new request which is a clone of the current one, apart |
1843
|
|
|
|
|
|
|
from the path location, which points instead to the new location. |
1844
|
|
|
|
|
|
|
This is used internally to chain requests using the forward keyword. |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
This method takes 3 parameters: the url to forward to, followed by an |
1847
|
|
|
|
|
|
|
optional hashref of parameters added to the current request parameters, |
1848
|
|
|
|
|
|
|
followed by a hashref of options regarding the redirect, such as |
1849
|
|
|
|
|
|
|
C<method> to change the request method. |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
For example: |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
forward '/login', { login_failed => 1 }, { method => 'GET' }); |
1854
|
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
|
=head2 app |
1856
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
Returns itself. This is simply available as a shim to help transition from |
1858
|
|
|
|
|
|
|
a previous version in which hooks were sent a context object (originally |
1859
|
|
|
|
|
|
|
C<Dancer2::Core::Context>) which has since been removed. |
1860
|
|
|
|
|
|
|
|
1861
|
|
|
|
|
|
|
# before |
1862
|
|
|
|
|
|
|
hook before => sub { |
1863
|
|
|
|
|
|
|
my $ctx = shift; |
1864
|
|
|
|
|
|
|
my $app = $ctx->app; |
1865
|
|
|
|
|
|
|
}; |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
# after |
1868
|
|
|
|
|
|
|
hook before => sub { |
1869
|
|
|
|
|
|
|
my $app = shift; |
1870
|
|
|
|
|
|
|
}; |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
This meant that C<< $app->app >> would fail, so this method has been provided |
1873
|
|
|
|
|
|
|
to make it work. |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
# now |
1876
|
|
|
|
|
|
|
hook before => sub { |
1877
|
|
|
|
|
|
|
my $WannaBeCtx = shift; |
1878
|
|
|
|
|
|
|
my $app = $WannaBeContext->app; # works |
1879
|
|
|
|
|
|
|
}; |
1880
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
=head2 lexical_prefix |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
Allow for setting a lexical prefix |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
$app->lexical_prefix('/blog', sub { |
1886
|
|
|
|
|
|
|
... |
1887
|
|
|
|
|
|
|
}); |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
All the route defined within the callback will have a prefix appended to the |
1890
|
|
|
|
|
|
|
current one. |
1891
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
=head2 C< $SIG{__DIE__} > Compatibility via C< $Dancer2::Core::App::EVAL_SHIM > |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
If an installation wishes to use C< $SIG{__DIE__} > hooks to enhance |
1895
|
|
|
|
|
|
|
their error handling then it may be required to ensure that certain |
1896
|
|
|
|
|
|
|
bookkeeping code is executed within every C<eval BLOCK> that Dancer2 |
1897
|
|
|
|
|
|
|
performs. This can be accomplished by overriding the global variable |
1898
|
|
|
|
|
|
|
C<$Dancer2::Core::App::EVAL_SHIM> with a subroutine which does whatever |
1899
|
|
|
|
|
|
|
logic is required. |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
This routine must perform the equivalent of the following subroutine: |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
our $EVAL_SHIM = sub { |
1904
|
|
|
|
|
|
|
my $code = shift; |
1905
|
|
|
|
|
|
|
return $code->(@_); |
1906
|
|
|
|
|
|
|
}; |
1907
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
An example of overriding this sub might be as follows: |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
$Dancer2::Core::App::EVAL_SHIM = sub { |
1911
|
|
|
|
|
|
|
my $code = shift; |
1912
|
|
|
|
|
|
|
local $IGNORE_EVAL_COUNTER = $IGNORE_EVAL_COUNTER + 1; |
1913
|
|
|
|
|
|
|
return $code->(@_); |
1914
|
|
|
|
|
|
|
}; |
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
B<Note:> that this is a GLOBAL setting, which must be set up before |
1917
|
|
|
|
|
|
|
any form of dispatch or use of Dancer2. |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
=head1 AUTHOR |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
Dancer Core Developers |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
This software is copyright (c) 2023 by Alexis Sukrieh. |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1928
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
=cut |