line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use Kelp::Base; |
3
|
31
|
|
|
31
|
|
180467
|
|
|
31
|
|
|
|
|
60
|
|
|
31
|
|
|
|
|
172
|
|
4
|
|
|
|
|
|
|
use Carp qw/ longmess croak /; |
5
|
31
|
|
|
31
|
|
2016
|
use FindBin; |
|
31
|
|
|
|
|
57
|
|
|
31
|
|
|
|
|
1824
|
|
6
|
31
|
|
|
31
|
|
12290
|
use Encode; |
|
31
|
|
|
|
|
27947
|
|
|
31
|
|
|
|
|
1150
|
|
7
|
31
|
|
|
31
|
|
11940
|
use Try::Tiny; |
|
31
|
|
|
|
|
335716
|
|
|
31
|
|
|
|
|
2097
|
|
8
|
31
|
|
|
31
|
|
205
|
use Data::Dumper; |
|
31
|
|
|
|
|
55
|
|
|
31
|
|
|
|
|
1302
|
|
9
|
31
|
|
|
31
|
|
16434
|
use Sys::Hostname; |
|
31
|
|
|
|
|
165806
|
|
|
31
|
|
|
|
|
1825
|
|
10
|
31
|
|
|
31
|
|
12704
|
use Plack::Util; |
|
31
|
|
|
|
|
28034
|
|
|
31
|
|
|
|
|
1678
|
|
11
|
31
|
|
|
31
|
|
11074
|
use Class::Inspector; |
|
31
|
|
|
|
|
261208
|
|
|
31
|
|
|
|
|
823
|
|
12
|
31
|
|
|
31
|
|
14150
|
use Scalar::Util qw(blessed); |
|
31
|
|
|
|
|
94407
|
|
|
31
|
|
|
|
|
1056
|
|
13
|
31
|
|
|
31
|
|
218
|
|
|
31
|
|
|
|
|
57
|
|
|
31
|
|
|
|
|
57444
|
|
14
|
|
|
|
|
|
|
our $VERSION = '1.06'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Basic attributes |
17
|
|
|
|
|
|
|
attr -host => hostname; |
18
|
|
|
|
|
|
|
attr mode => $ENV{KELP_ENV} // $ENV{PLACK_ENV} // 'development'; |
19
|
|
|
|
|
|
|
attr -path => $FindBin::Bin; |
20
|
|
|
|
|
|
|
attr -name => sub { ( ref( $_[0] ) =~ /(\w+)$/ ) ? $1 : 'Noname' }; |
21
|
|
|
|
|
|
|
attr request_obj => 'Kelp::Request'; |
22
|
|
|
|
|
|
|
attr response_obj => 'Kelp::Response'; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Debug |
26
|
|
|
|
|
|
|
attr long_error => $ENV{KELP_LONG_ERROR} // 0; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# The charset is UTF-8 unless otherwise instructed |
29
|
|
|
|
|
|
|
attr -charset => sub { |
30
|
|
|
|
|
|
|
$_[0]->config("charset") // 'UTF-8'; |
31
|
|
|
|
|
|
|
}; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Name the config module |
34
|
|
|
|
|
|
|
attr config_module => 'Config'; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Undocumented. |
37
|
|
|
|
|
|
|
# Used to unlock the undocumented features of the Config module. |
38
|
|
|
|
|
|
|
attr __config => undef; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
attr -loaded_modules => sub { {} }; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Each route's request an response objects will |
43
|
|
|
|
|
|
|
# be put here: |
44
|
|
|
|
|
|
|
attr req => undef; |
45
|
|
|
|
|
|
|
attr res => undef; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Initialization |
48
|
|
|
|
|
|
|
my $self = shift->SUPER::new(@_); |
49
|
|
|
|
|
|
|
|
50
|
41
|
|
|
41
|
1
|
3682
|
# Always load these modules, but allow client to override |
51
|
|
|
|
|
|
|
$self->_load_config(); |
52
|
|
|
|
|
|
|
$self->_load_routes(); |
53
|
41
|
|
|
|
|
161
|
|
54
|
40
|
|
|
|
|
173
|
# Load the modules from the config |
55
|
|
|
|
|
|
|
if ( defined( my $modules = $self->config('modules') ) ) { |
56
|
|
|
|
|
|
|
$self->load_module($_) for (@$modules); |
57
|
40
|
50
|
|
|
|
141
|
} |
58
|
40
|
|
|
|
|
164
|
|
59
|
|
|
|
|
|
|
$self->build(); |
60
|
|
|
|
|
|
|
return $self; |
61
|
40
|
|
|
|
|
148
|
} |
62
|
40
|
|
|
|
|
133
|
|
63
|
|
|
|
|
|
|
my $last_anon = 0; |
64
|
|
|
|
|
|
|
my $class = shift; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# make sure we don't eval something dodgy |
67
|
6
|
|
|
6
|
1
|
296
|
die "invalid class for new_anon" |
68
|
|
|
|
|
|
|
if ref $class # not a string |
69
|
|
|
|
|
|
|
|| !$class # not an empty string, undef or 0 |
70
|
6
|
100
|
66
|
|
|
56
|
|| !Class::Inspector->loaded($class) # not a loaded class |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
71
|
|
|
|
|
|
|
|| !$class->isa(__PACKAGE__) # not a correct class |
72
|
|
|
|
|
|
|
; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my $anon_class = "Kelp::Anonymous::$class" . ++$last_anon; |
75
|
|
|
|
|
|
|
my $err = do { |
76
|
|
|
|
|
|
|
local $@; |
77
|
4
|
|
|
|
|
137
|
my $eval_status = eval qq[ |
78
|
4
|
|
|
|
|
4
|
{ |
79
|
4
|
|
|
|
|
7
|
package $anon_class; |
80
|
4
|
|
|
2
|
|
290
|
use parent -norequire, '$class'; |
|
2
|
|
|
1
|
|
12
|
|
|
2
|
|
|
1
|
|
4
|
|
|
2
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
15
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
1; |
83
|
|
|
|
|
|
|
]; |
84
|
|
|
|
|
|
|
$@ || !$eval_status; |
85
|
|
|
|
|
|
|
}; |
86
|
|
|
|
|
|
|
|
87
|
4
|
50
|
|
|
|
28
|
if ($err) { |
88
|
|
|
|
|
|
|
die "Couldn't create anonymous Kelp instance: " . |
89
|
|
|
|
|
|
|
(length $err > 1 ? $err : 'unknown error'); |
90
|
4
|
50
|
|
|
|
8
|
} |
91
|
0
|
0
|
|
|
|
0
|
|
92
|
|
|
|
|
|
|
return $anon_class->new(@_); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
4
|
|
|
|
|
48
|
my $self = shift; |
96
|
|
|
|
|
|
|
$self->load_module( $self->config_module, extra => $self->__config ); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
41
|
|
|
41
|
|
78
|
my $self = shift; |
100
|
41
|
|
|
|
|
153
|
$self->load_module('Routes'); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Create a shallow copy of the app, optionally blessed into a |
104
|
40
|
|
|
40
|
|
84
|
# different subclass. |
105
|
40
|
|
|
|
|
111
|
my $self = shift; |
106
|
|
|
|
|
|
|
my $subclass = shift || ref($self); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
ref $self or croak '_clone requires instance'; |
109
|
|
|
|
|
|
|
return bless { %$self }, $subclass; |
110
|
|
|
|
|
|
|
} |
111
|
5
|
|
|
5
|
|
7
|
|
112
|
5
|
|
33
|
|
|
8
|
my ( $self, $name, %args ) = @_; |
113
|
|
|
|
|
|
|
|
114
|
5
|
50
|
|
|
|
11
|
# A module name with a leading + indicates it's already fully |
115
|
5
|
|
|
|
|
50
|
# qualified (i.e., it does not need the Kelp::Module:: prefix). |
116
|
|
|
|
|
|
|
my $prefix = $name =~ s/^\+// ? undef : 'Kelp::Module'; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# Make sure the module was not already loaded |
119
|
162
|
|
|
162
|
1
|
1063
|
return if $self->loaded_modules->{$name}; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $class = Plack::Util::load_class( $name, $prefix ); |
122
|
|
|
|
|
|
|
my $module = $self->loaded_modules->{$name} = $class->new( app => $self ); |
123
|
162
|
100
|
|
|
|
430
|
|
124
|
|
|
|
|
|
|
# When loading the Config module itself, we don't have |
125
|
|
|
|
|
|
|
# access to $self->config yet. This is why we check if |
126
|
162
|
50
|
|
|
|
415
|
# config is available, and if it is, then we pull the |
127
|
|
|
|
|
|
|
# initialization hash. |
128
|
162
|
|
|
|
|
499
|
my $args_from_config = {}; |
129
|
161
|
|
|
|
|
2108
|
if ( $self->can('config') ) { |
130
|
|
|
|
|
|
|
$args_from_config = $self->config("modules_init.$name") // {}; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
$module->build( %$args_from_config, %args ); |
134
|
|
|
|
|
|
|
return $module; |
135
|
161
|
|
|
|
|
271
|
} |
136
|
161
|
100
|
|
|
|
664
|
|
137
|
128
|
|
100
|
|
|
420
|
# Override this one to add custom initializations |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
161
|
|
|
|
|
762
|
# Override to use a custom request object |
141
|
160
|
|
|
|
|
491
|
my ( $self, $env ) = @_; |
142
|
|
|
|
|
|
|
my $package = $self->request_obj; |
143
|
|
|
|
|
|
|
eval qq{require $package}; |
144
|
|
|
|
|
|
|
return $package->new( app => $self, env => $env); |
145
|
|
|
|
34
|
1
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Override to use a custom response object |
148
|
|
|
|
|
|
|
my $self = shift; |
149
|
|
|
|
|
|
|
my $package = $self->response_obj; |
150
|
202
|
|
|
202
|
1
|
289
|
eval qq{require $package}; |
151
|
202
|
|
|
|
|
568
|
return $package->new( app => $self ); |
152
|
202
|
|
|
|
|
11004
|
} |
153
|
202
|
|
|
|
|
1293
|
|
154
|
|
|
|
|
|
|
# Override to manipulate the end response |
155
|
|
|
|
|
|
|
my $self = shift; |
156
|
|
|
|
|
|
|
$self->res->header('X-Framework' => 'Perl Kelp'); |
157
|
|
|
|
|
|
|
} |
158
|
196
|
|
|
196
|
1
|
290
|
|
159
|
196
|
|
|
|
|
417
|
# Override this to wrap more middleware around the app |
160
|
196
|
|
|
|
|
9871
|
my $self = shift; |
161
|
196
|
|
|
|
|
1116
|
my $app = sub { $self->psgi(@_) }; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Add middleware |
164
|
|
|
|
|
|
|
if ( defined( my $middleware = $self->config('middleware') ) ) { |
165
|
|
|
|
|
|
|
for my $class (@$middleware) { |
166
|
192
|
|
|
192
|
1
|
216
|
|
167
|
192
|
|
|
|
|
292
|
# Make sure the middleware was not already loaded |
168
|
|
|
|
|
|
|
# This does not apply for testing, in which case we want |
169
|
|
|
|
|
|
|
# the middleware to wrap every single time |
170
|
|
|
|
|
|
|
next if $self->{_loaded_middleware}->{$class}++ && !$ENV{KELP_TESTING}; |
171
|
|
|
|
|
|
|
|
172
|
201
|
|
|
201
|
1
|
348
|
my $mw = Plack::Util::load_class($class, 'Plack::Middleware'); |
173
|
201
|
|
|
201
|
|
982
|
my $args = $self->config("middleware_init.$class") // {}; |
|
201
|
|
|
|
|
133013
|
|
174
|
|
|
|
|
|
|
$app = $mw->wrap( $app, %$args ); |
175
|
|
|
|
|
|
|
} |
176
|
201
|
50
|
|
|
|
748
|
} |
177
|
201
|
|
|
|
|
356
|
|
178
|
|
|
|
|
|
|
return $app; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
my ( $self, $env ) = @_; |
182
|
7
|
50
|
66
|
|
|
89
|
|
183
|
|
|
|
|
|
|
# Create the request and response objects |
184
|
7
|
|
|
|
|
32
|
my $req = $self->req( $self->build_request($env) ); |
185
|
7
|
|
100
|
|
|
11272
|
my $res = $self->res( $self->build_response ); |
186
|
7
|
|
|
|
|
60
|
|
187
|
|
|
|
|
|
|
# Get route matches |
188
|
|
|
|
|
|
|
my $match = $self->routes->match( $req->path, $req->method ); |
189
|
|
|
|
|
|
|
|
190
|
201
|
|
|
|
|
53081
|
# None found? Show 404 ... |
191
|
|
|
|
|
|
|
if ( !@$match ) { |
192
|
|
|
|
|
|
|
$res->render_404; |
193
|
|
|
|
|
|
|
return $self->finalize; |
194
|
201
|
|
|
201
|
0
|
399
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
try { |
197
|
201
|
|
|
|
|
450
|
|
198
|
201
|
|
|
|
|
493
|
# Go over the entire route chain |
199
|
|
|
|
|
|
|
for my $route (@$match) { |
200
|
|
|
|
|
|
|
|
201
|
201
|
|
|
|
|
583
|
# Dispatch |
202
|
|
|
|
|
|
|
$self->req->named( $route->named ); |
203
|
|
|
|
|
|
|
$self->req->route_name( $route->name ); |
204
|
201
|
100
|
|
|
|
462
|
my $data = $self->routes->dispatch( $self, $route ); |
205
|
7
|
|
|
|
|
21
|
|
206
|
7
|
|
|
|
|
18
|
# Log info about the route |
207
|
|
|
|
|
|
|
if ( $self->can('logger') ) { |
208
|
|
|
|
|
|
|
$self->info( |
209
|
|
|
|
|
|
|
sprintf( "%s - %s %s - %s", |
210
|
|
|
|
|
|
|
$req->address, $req->method, |
211
|
|
|
|
|
|
|
$req->path, $route->to ) |
212
|
194
|
|
|
194
|
|
7012
|
); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
198
|
|
|
|
|
478
|
# Is it a bridge? Bridges must return a true value |
216
|
198
|
|
|
|
|
442
|
# to allow the rest of the routes to run. |
217
|
198
|
|
|
|
|
443
|
if ( $route->bridge ) { |
218
|
|
|
|
|
|
|
if ( !$data ) { |
219
|
|
|
|
|
|
|
$res->render_403 unless $res->rendered; |
220
|
166
|
100
|
|
|
|
7586
|
last; |
221
|
1
|
|
|
|
|
4
|
} |
222
|
|
|
|
|
|
|
next; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# If the route returned something, then analyze it and render it |
226
|
|
|
|
|
|
|
if ( defined $data ) { |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Handle delayed response if CODE |
229
|
|
|
|
|
|
|
return $data if ref($data) eq 'CODE'; |
230
|
166
|
100
|
|
|
|
423
|
$res->render($data) unless $res->rendered; |
231
|
10
|
100
|
|
|
|
19
|
} |
232
|
4
|
100
|
|
|
|
7
|
} |
233
|
4
|
|
|
|
|
7
|
|
234
|
|
|
|
|
|
|
# If nothing got rendered |
235
|
6
|
|
|
|
|
10
|
if ( !$self->res->rendered ) { |
236
|
|
|
|
|
|
|
# render 404 if only briges matched |
237
|
|
|
|
|
|
|
if ( $match->[-1]->bridge ) { |
238
|
|
|
|
|
|
|
$res->render_404; |
239
|
156
|
100
|
|
|
|
293
|
} |
240
|
|
|
|
|
|
|
# or die with error |
241
|
|
|
|
|
|
|
else { |
242
|
154
|
100
|
|
|
|
294
|
die $match->[-1]->to |
243
|
153
|
100
|
|
|
|
319
|
. " did not render for method " |
244
|
|
|
|
|
|
|
. $req->method; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
159
|
100
|
|
|
|
329
|
$self->finalize; |
249
|
|
|
|
|
|
|
} |
250
|
3
|
100
|
|
|
|
15
|
catch { |
251
|
1
|
|
|
|
|
3
|
my $exception = $_; |
252
|
|
|
|
|
|
|
my $res = $self->res; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
if (blessed $exception && $exception->isa('Kelp::Exception')) { |
255
|
2
|
|
|
|
|
4
|
# No logging here, since it is a message for the user with a code |
256
|
|
|
|
|
|
|
# rather than a real exceptional case |
257
|
|
|
|
|
|
|
# (Nothing really broke, user code invoked this) |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
$res->render_exception($exception); |
260
|
|
|
|
|
|
|
} |
261
|
157
|
|
|
|
|
300
|
else { |
262
|
|
|
|
|
|
|
my $message = $self->long_error ? longmess($exception) : $exception; |
263
|
|
|
|
|
|
|
|
264
|
36
|
|
|
36
|
|
1690
|
# Log error |
265
|
36
|
|
|
|
|
86
|
$self->logger( 'critical', $message ) if $self->can('logger'); |
266
|
|
|
|
|
|
|
|
267
|
36
|
100
|
100
|
|
|
539
|
# Render 500 |
268
|
|
|
|
|
|
|
$res->render_500($_); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
$self->finalize; |
271
|
|
|
|
|
|
|
}; |
272
|
12
|
|
|
|
|
54
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
my $self = shift; |
275
|
24
|
50
|
|
|
|
60
|
$self->before_finalize; |
276
|
|
|
|
|
|
|
$self->res->finalize; |
277
|
|
|
|
|
|
|
} |
278
|
24
|
50
|
|
|
|
85
|
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
#---------------------------------------------------------------- |
281
|
24
|
|
|
|
|
55
|
# Request and Response shortcuts |
282
|
|
|
|
|
|
|
#---------------------------------------------------------------- |
283
|
33
|
|
|
|
|
194
|
my $self = shift; |
284
|
194
|
|
|
|
|
1497
|
unshift @_, $self->req; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# goto will allow carp show the correct caller |
287
|
|
|
|
|
|
|
goto $_[0]->can('param'); |
288
|
197
|
|
|
197
|
0
|
236
|
} |
289
|
197
|
|
|
|
|
418
|
|
290
|
197
|
|
|
|
|
7224
|
|
291
|
|
|
|
|
|
|
my $self = shift; |
292
|
|
|
|
|
|
|
@_ ? $self->req->stash->{$_[0]} : $self->req->stash; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my $self = shift; |
296
|
|
|
|
|
|
|
@_ ? $self->req->named->{$_[0]} : $self->req->named; |
297
|
|
|
|
|
|
|
} |
298
|
68
|
|
|
68
|
1
|
2834
|
|
299
|
68
|
|
|
|
|
121
|
#---------------------------------------------------------------- |
300
|
|
|
|
|
|
|
# Utility |
301
|
|
|
|
|
|
|
#---------------------------------------------------------------- |
302
|
68
|
|
|
|
|
273
|
|
303
|
|
|
|
|
|
|
my ( $self, $name, @args ) = @_; |
304
|
|
|
|
|
|
|
my $result = $name; |
305
|
0
|
|
|
0
|
1
|
0
|
try { $result = $self->routes->url( $name, @args ) }; |
306
|
|
|
|
|
|
|
return $result; |
307
|
|
|
|
|
|
|
} |
308
|
2
|
|
|
2
|
1
|
3
|
|
309
|
2
|
100
|
|
|
|
8
|
my ( $self, $name, @args ) = @_; |
310
|
|
|
|
|
|
|
my $url = $self->url_for( $name, @args ); |
311
|
|
|
|
|
|
|
return URI->new_abs( $url, $self->config('app_url') )->as_string; |
312
|
|
|
|
|
|
|
} |
313
|
21
|
|
|
21
|
1
|
58
|
|
314
|
21
|
50
|
|
|
|
44
|
1; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=pod |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head1 NAME |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Kelp - A web framework light, yet rich in nutrients. |
322
|
7
|
|
|
7
|
1
|
16
|
|
323
|
7
|
|
|
|
|
10
|
=head1 SYNOPSIS |
324
|
7
|
|
|
7
|
|
49
|
|
|
7
|
|
|
|
|
146
|
|
325
|
7
|
|
|
|
|
81
|
package MyApp; |
326
|
|
|
|
|
|
|
use parent 'Kelp'; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# bootstrap your application |
329
|
0
|
|
|
0
|
1
|
0
|
sub build { |
330
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
331
|
0
|
|
|
|
|
0
|
|
332
|
|
|
|
|
|
|
my $r = $self->routes; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$r->add('/simple/route', 'route_handler'); |
335
|
|
|
|
|
|
|
$r->add('/route/:name', { |
336
|
|
|
|
|
|
|
to => 'namespace::controller::action', |
337
|
|
|
|
|
|
|
... # other options, see Kelp::Routes |
338
|
|
|
|
|
|
|
}); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# example route handler |
342
|
|
|
|
|
|
|
sub route_handler { |
343
|
|
|
|
|
|
|
my ($kelp_instance, @route_parameters) = @_; |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
return 'text to be rendered'; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
1; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head1 DESCRIPTION |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Kelp is a light, modular web framework built on top of Plack. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
This document lists all the methods and attributes available in the main |
355
|
|
|
|
|
|
|
instance of a Kelp application, passed as a first argument to route handling |
356
|
|
|
|
|
|
|
routines. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
See L<Kelp::Manual> for a complete reference. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
See L<Kelp::Manual::Cookbook> for solutions to common problems. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head2 hostname |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Gets the current hostname. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub some_route { |
369
|
|
|
|
|
|
|
my $self = shift; |
370
|
|
|
|
|
|
|
if ( $self->hostname eq 'prod-host' ) { |
371
|
|
|
|
|
|
|
... |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head2 mode |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Sets or gets the current mode. The mode is important for the app to know what |
378
|
|
|
|
|
|
|
configuration file to merge into the main configuration. See |
379
|
|
|
|
|
|
|
L<Kelp::Module::Config> for more information. |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
my $app = MyApp->new( mode => 'development' ); |
382
|
|
|
|
|
|
|
# conf/config.pl and conf/development.pl are merged with priority |
383
|
|
|
|
|
|
|
# given to the second one. |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 request_obj |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Provide a custom package name to define the global ::Request object. Defaults to |
388
|
|
|
|
|
|
|
L<Kelp::Request>. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 response_obj |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Provide a custom package name to define the global ::Response object. Defaults to |
393
|
|
|
|
|
|
|
L<Kelp::Response>. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head2 config_module |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Sets of gets the class of the configuration module to be loaded on startup. The |
398
|
|
|
|
|
|
|
default value is C<Config>, which will cause the C<Kelp::Module::Config> to get |
399
|
|
|
|
|
|
|
loaded. See the documentation for L<Kelp::Module::Config> for more information |
400
|
|
|
|
|
|
|
and for an example of how to create and use other config modules. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=head2 loaded_modules |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
A hashref containing the names and instances of all loaded modules. For example, |
405
|
|
|
|
|
|
|
if you have these two modules loaded: Template and JSON, then a dump of |
406
|
|
|
|
|
|
|
the C<loaded_modules> hash will look like this: |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
|
Template => Kelp::Module::Template=HASH(0x208f6e8), |
410
|
|
|
|
|
|
|
JSON => Kelp::Module::JSON=HASH(0x209d454) |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
This can come in handy if your module does more than just registering a new method |
414
|
|
|
|
|
|
|
into the application. Then, you can use its object instance to access that |
415
|
|
|
|
|
|
|
additional functionality. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head2 path |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Gets the current path of the application. That would be the path to C<app.psgi> |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head2 name |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Gets or sets the name of the application. If not set, the name of the main |
425
|
|
|
|
|
|
|
class will be used. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
my $app = MyApp->new( name => 'Twittar' ); |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head2 charset |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
Sets of gets the encoding charset of the app. It will be C<UTF-8>, if not set to |
432
|
|
|
|
|
|
|
anything else. The charset could also be changed in the config files. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head2 long_error |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
When a route dies, Kelp will by default display a short error message. Set this |
437
|
|
|
|
|
|
|
attribute to a true value if you need to see a full stack trace of the error. |
438
|
|
|
|
|
|
|
The C<KELP_LONG_ERROR> environment variable can also set this attribute. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=head2 req |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
This attribute only makes sense if called within a route definition. It will |
443
|
|
|
|
|
|
|
contain a reference to the current L<Kelp::Request> instance. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub some_route { |
446
|
|
|
|
|
|
|
my $self = shift; |
447
|
|
|
|
|
|
|
if ( $self->req->is_json ) { |
448
|
|
|
|
|
|
|
... |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head2 res |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
This attribute only makes sense if called within a route definition. It will |
455
|
|
|
|
|
|
|
contain a reference to the current L<Kelp::Response> instance. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub some_route { |
458
|
|
|
|
|
|
|
my $self = shift; |
459
|
|
|
|
|
|
|
$self->res->json->render( { success => 1 } ); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head1 METHODS |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head2 new |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
my $the_only_kelp = KelpApp->new; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
A standard constructor. B<Cannot> be called multiple times: see L</new_anon>. |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=head2 new_anon |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
my $kelp1 = KelpApp->new_anon(config => 'conf1'); |
473
|
|
|
|
|
|
|
my $kelp2 = KelpApp->new_anon(config => 'conf2'); |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
A constructor that can be called repeatedly. Cannot be mixed with L</new>. |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
It works by creating a new anonymous class extending the class of your |
478
|
|
|
|
|
|
|
application and running I<new> on it. C<ref $kelp> will return I<something |
479
|
|
|
|
|
|
|
else> than the name of your Kelp class, but C<< $kelp->isa('KelpApp') >> will |
480
|
|
|
|
|
|
|
be true. This will likely be useful during testing or when running multiple |
481
|
|
|
|
|
|
|
instances of the same application with different configurations. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=head2 build |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
On its own, the C<build> method doesn't do anything. It is called by the |
486
|
|
|
|
|
|
|
constructor, so it can be overridden to add route destinations and |
487
|
|
|
|
|
|
|
initializations. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
package MyApp; |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub build { |
492
|
|
|
|
|
|
|
my $self = shift; |
493
|
|
|
|
|
|
|
my $r = $self->routes; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Load some modules |
496
|
|
|
|
|
|
|
$self->load_module("MongoDB"); |
497
|
|
|
|
|
|
|
$self->load_module("Validate"); |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# Add all route destinations |
500
|
|
|
|
|
|
|
$r->add("/one", "one"); |
501
|
|
|
|
|
|
|
... |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=head2 load_module |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
C<load_module($name, %options)> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Used to load a module. All modules must be under the C<Kelp::Module::> |
510
|
|
|
|
|
|
|
namespace. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
$self->load_module("Redis", server => '127.0.0.1'); |
513
|
|
|
|
|
|
|
# Will look for and load Kelp::Module::Redis |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Options for the module may be specified after its name, or in the |
516
|
|
|
|
|
|
|
C<modules_init> hash in the config. Precedence is given to the |
517
|
|
|
|
|
|
|
inline options. |
518
|
|
|
|
|
|
|
See L<Kelp::Module> for more information on making and using modules. |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=head2 build_request |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
This method is used to create the request object for each HTTP request. It |
523
|
|
|
|
|
|
|
returns an instance of the class defined in the request_obj attribute (defaults to |
524
|
|
|
|
|
|
|
L<Kelp::Request>), initialized with the current request's environment. You can |
525
|
|
|
|
|
|
|
override this method to use a custom request module if you need to do something |
526
|
|
|
|
|
|
|
interesting. Though there is a provided attribute that can be used to overide |
527
|
|
|
|
|
|
|
the class of the object used. |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
package MyApp; |
530
|
|
|
|
|
|
|
use MyApp::Request; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub build_request { |
533
|
|
|
|
|
|
|
my ( $self, $env ) = @_; |
534
|
|
|
|
|
|
|
return MyApp::Request->new( app => $app, env => $env ); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# Now each request will be handled by MyApp::Request |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=head2 before_finalize |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
Override this method to modify the response object just before it gets |
542
|
|
|
|
|
|
|
finalized. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
package MyApp; |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub before_finalize { |
547
|
|
|
|
|
|
|
my $self = shift; |
548
|
|
|
|
|
|
|
$self->res->set_header("X-App-Name", "MyApp"); |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
... |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
The above is an example of how to insert a custom header into the response of |
554
|
|
|
|
|
|
|
every route. |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=head2 build_response |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
This method creates the response object, e.g. what an HTTP request will return. |
559
|
|
|
|
|
|
|
By default the object created is L<Kelp::Response> though this can be |
560
|
|
|
|
|
|
|
overwritten via the respone_obj attribute. Much like L</build_request>, the |
561
|
|
|
|
|
|
|
response can also be overridden to use a custom response object if you need |
562
|
|
|
|
|
|
|
something completely custom. |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=head2 run |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
This method builds and returns the PSGI app. You can override it in order to |
567
|
|
|
|
|
|
|
include middleware. See L<Kelp::Manual/Adding middleware> for an example. |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=head2 param |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
A shortcut to C<$self-E<gt>req-E<gt>param>: |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub some_route { |
574
|
|
|
|
|
|
|
my $self = shift; |
575
|
|
|
|
|
|
|
if ( $self->param('age') > 18 ) { |
576
|
|
|
|
|
|
|
$self->can_watch_south_path(1); |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
This function can be tricky to use because of context sensivity. See |
581
|
|
|
|
|
|
|
L<Kelp::Request/param> for more information and examples. |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 session |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
A shortcut to C<$self-E<gt>req-E<gt>session>. Take a look at L<Kelp::Request/session> |
586
|
|
|
|
|
|
|
for more information and examples. |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=head2 stash |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Provides safe access to C<$self-E<gt>req-E<gt>stash>. When called without |
591
|
|
|
|
|
|
|
arguments, it will return the stash hash. If called with a single argument, it |
592
|
|
|
|
|
|
|
will return the value of the corresponding key in the stash. |
593
|
|
|
|
|
|
|
See L<Kelp::Request/stash> for more information and examples. |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=head2 named |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
Provides safe access to C<$self-E<gt>req-E<gt>named>. When called without |
598
|
|
|
|
|
|
|
arguments, it will return the named hash. If called with a single argument, it |
599
|
|
|
|
|
|
|
will return the value of the corresponding key in the named hash. |
600
|
|
|
|
|
|
|
See L<Kelp::Request/named> for more information and examples. |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=head2 url_for |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
A safe shortcut to C<$self-E<gt>routes-E<gt>url>. Builds a URL from path and |
605
|
|
|
|
|
|
|
arguments. |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
sub build { |
608
|
|
|
|
|
|
|
my $self = shift; |
609
|
|
|
|
|
|
|
$self->routes->add("/:name/:id", { name => 'name', to => sub { |
610
|
|
|
|
|
|
|
... |
611
|
|
|
|
|
|
|
}}); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub check { |
615
|
|
|
|
|
|
|
my $self = shift; |
616
|
|
|
|
|
|
|
my $url_for_name = $self->url_for('name', name => 'jake', id => 1003); |
617
|
|
|
|
|
|
|
$self->res->redirect_to( $url_for_name ); |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=head2 abs_url |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
Same as L</url_for>, but returns the full absolute URI for the current |
623
|
|
|
|
|
|
|
application (based on configuration). |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=head1 AUTHOR |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Stefan Geneshky - minimal <at> cpan.org |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head1 LICENSE |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
This module and all the modules in this package are governed by the same license |
632
|
|
|
|
|
|
|
as Perl itself. |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=cut |
635
|
|
|
|
|
|
|
|