Commit | Line | Data |
54642e5a |
1 | package Catalyst::Context; |
2 | |
3 | use Moose; |
0a2c51b7 |
4 | use bytes; |
5 | use B::Hooks::EndOfScope (); |
6 | use Catalyst::Exception; |
7 | use Catalyst::Exception::Detach; |
8 | use Catalyst::Exception::Go; |
9 | use Catalyst::Request; |
10 | use Catalyst::Request::Upload; |
11 | use Catalyst::Response; |
12 | use Catalyst::Utils; |
13 | use File::stat; |
14 | use Text::SimpleTable (); |
15 | use Path::Class::Dir (); |
16 | use Path::Class::File (); |
17 | use URI (); |
18 | use URI::http; |
19 | use URI::https; |
20 | use Tree::Simple::Visitor::FindByUID; |
21 | use utf8; |
22 | use Carp qw/croak carp shortmess/; |
23 | |
54642e5a |
24 | |
54642e5a |
25 | has action => (is => 'rw'); |
26 | has counter => (is => 'rw', default => sub { {} }); |
27 | has namespace => (is => 'rw'); |
28 | has request_class => (is => 'ro', default => 'Catalyst::Request'); |
29 | has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1); |
30 | has response_class => (is => 'ro', default => 'Catalyst::Response'); |
31 | has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1); |
32 | has stack => (is => 'ro', default => sub { [] }); |
33 | has stash => (is => 'rw', default => sub { {} }); |
34 | has state => (is => 'rw', default => 0); |
35 | has stats => (is => 'rw'); |
36 | |
0a2c51b7 |
37 | has 'application' => ( |
38 | isa => 'Catalyst', |
39 | is => 'ro', |
40 | handles => [ |
41 | qw/ |
42 | controllers |
43 | models |
44 | views |
45 | component |
4b16d376 |
46 | config |
0a2c51b7 |
47 | log |
48 | debug |
49 | dispatcher |
50 | engine |
51 | path_to |
52 | plugin |
53 | setup_finalize |
54 | welcome_message |
55 | components |
56 | context_class |
57 | dispatcher_class |
58 | prepare |
59 | engine_class |
60 | setup_actions |
0a2c51b7 |
61 | search_extra |
62 | root |
63 | parse_on_demand |
64 | name |
65 | ignore_frontend_proxy |
66 | home |
67 | default_model |
68 | default_view |
69 | version |
70 | use_stats |
71 | stats_class |
72 | set_action |
73 | |
74 | ran_setup |
75 | _comp_search_prefixes |
76 | _filter_component |
77 | / |
78 | ], |
79 | ); |
80 | |
81 | sub depth { scalar @{ shift->stack || [] }; } |
82 | |
83 | sub req { |
84 | my $self = shift; return $self->request(@_); |
85 | } |
86 | sub res { |
87 | my $self = shift; return $self->response(@_); |
88 | } |
89 | |
90 | # For backwards compatibility |
91 | sub finalize_output { shift->finalize_body(@_) }; |
92 | |
93 | # For statistics |
94 | our $COUNT = 1; |
95 | our $START = time; |
96 | our $RECURSION = 1000; |
97 | our $DETACH = Catalyst::Exception::Detach->new; |
98 | our $GO = Catalyst::Exception::Go->new; |
99 | |
100 | |
101 | |
102 | =head1 METHODS |
103 | |
104 | =head2 INFORMATION ABOUT THE CURRENT REQUEST |
105 | |
106 | =head2 $c->action |
107 | |
108 | Returns a L<Catalyst::Action> object for the current action, which |
109 | stringifies to the action name. See L<Catalyst::Action>. |
110 | |
111 | =head2 $c->namespace |
112 | |
113 | Returns the namespace of the current action, i.e., the URI prefix |
114 | corresponding to the controller of the current action. For example: |
115 | |
116 | # in Controller::Foo::Bar |
117 | $c->namespace; # returns 'foo/bar'; |
118 | |
119 | =head2 $c->request |
120 | |
121 | =head2 $c->req |
122 | |
123 | Returns the current L<Catalyst::Request> object, giving access to |
124 | information about the current client request (including parameters, |
125 | cookies, HTTP headers, etc.). See L<Catalyst::Request>. |
126 | |
127 | =head2 REQUEST FLOW HANDLING |
128 | |
129 | =head2 $c->forward( $action [, \@arguments ] ) |
130 | |
131 | =head2 $c->forward( $class, $method, [, \@arguments ] ) |
132 | |
133 | Forwards processing to another action, by its private name. If you give a |
134 | class name but no method, C<process()> is called. You may also optionally |
135 | pass arguments in an arrayref. The action will receive the arguments in |
136 | C<@_> and C<< $c->req->args >>. Upon returning from the function, |
137 | C<< $c->req->args >> will be restored to the previous values. |
138 | |
139 | Any data C<return>ed from the action forwarded to, will be returned by the |
140 | call to forward. |
141 | |
142 | my $foodata = $c->forward('/foo'); |
143 | $c->forward('index'); |
144 | $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/); |
145 | $c->forward('MyApp::View::TT'); |
146 | |
147 | Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies |
148 | an C<< eval { } >> around the call (actually |
149 | L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing |
150 | all 'dies' within the called action. If you want C<die> to propagate you |
151 | need to do something like: |
152 | |
153 | $c->forward('foo'); |
154 | die $c->error if $c->error; |
155 | |
156 | Or make sure to always return true values from your actions and write |
157 | your code like this: |
158 | |
159 | $c->forward('foo') || return; |
160 | |
161 | Another note is that C<< $c->forward >> always returns a scalar because it |
162 | actually returns $c->state which operates in a scalar context. |
163 | Thus, something like: |
164 | |
165 | return @array; |
166 | |
167 | in an action that is forwarded to is going to return a scalar, |
168 | i.e. how many items are in that array, which is probably not what you want. |
169 | If you need to return an array then return a reference to it, |
170 | or stash it like so: |
171 | |
172 | $c->stash->{array} = \@array; |
173 | |
174 | and access it from the stash. |
175 | |
176 | =cut |
177 | |
178 | sub forward { |
179 | my $c = shift; |
180 | no warnings 'recursion'; |
181 | my $dispatcher = $c->dispatcher; |
182 | $dispatcher->forward( $c, @_ ); |
183 | } |
184 | |
185 | =head2 $c->detach( $action [, \@arguments ] ) |
186 | |
187 | =head2 $c->detach( $class, $method, [, \@arguments ] ) |
188 | |
189 | =head2 $c->detach() |
190 | |
191 | The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but |
192 | doesn't return to the previous action when processing is finished. |
193 | |
194 | When called with no arguments it escapes the processing chain entirely. |
195 | |
196 | =cut |
197 | |
198 | sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) } |
199 | |
200 | =head2 $c->visit( $action [, \@captures, \@arguments ] ) |
201 | |
202 | =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] ) |
203 | |
204 | Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, |
205 | but does a full dispatch, instead of just calling the new C<$action> / |
206 | C<< $class->$method >>. This means that C<begin>, C<auto> and the method |
207 | you go to are called, just like a new request. |
208 | |
209 | In addition both C<< $c->action >> and C<< $c->namespace >> are localized. |
210 | This means, for example, that C<< $c->action >> methods such as |
211 | L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and |
212 | L<reverse|Catalyst::Action/reverse> return information for the visited action |
213 | when they are invoked within the visited action. This is different from the |
214 | behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which |
215 | continues to use the $c->action object from the caller action even when |
216 | invoked from the callee. |
217 | |
218 | C<< $c->stash >> is kept unchanged. |
219 | |
220 | In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> |
221 | allows you to "wrap" another action, just as it would have been called by |
222 | dispatching from a URL, while the analogous |
223 | L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to |
224 | transfer control to another action as if it had been reached directly from a URL. |
225 | |
226 | =cut |
227 | |
228 | sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } |
229 | |
230 | =head2 $c->go( $action [, \@captures, \@arguments ] ) |
231 | |
232 | =head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) |
233 | |
234 | The relationship between C<go> and |
235 | L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as |
236 | the relationship between |
237 | L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and |
238 | L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>, |
239 | C<< $c->go >> will perform a full dispatch on the specified action or method, |
240 | with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>, |
241 | C<go> escapes the processing of the current request chain on completion, and |
242 | does not return to its caller. |
243 | |
244 | =cut |
245 | |
246 | sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) } |
247 | |
248 | =head2 $c->response |
249 | |
250 | =head2 $c->res |
251 | |
252 | Returns the current L<Catalyst::Response> object, see there for details. |
253 | |
254 | =head2 $c->stash |
255 | |
256 | Returns a hashref to the stash, which may be used to store data and pass |
257 | it between components during a request. You can also set hash keys by |
258 | passing arguments. The stash is automatically sent to the view. The |
259 | stash is cleared at the end of a request; it cannot be used for |
260 | persistent storage (for this you must use a session; see |
261 | L<Catalyst::Plugin::Session> for a complete system integrated with |
262 | Catalyst). |
263 | |
264 | $c->stash->{foo} = $bar; |
265 | $c->stash( { moose => 'majestic', qux => 0 } ); |
266 | $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref |
267 | |
268 | # stash is automatically passed to the view for use in a template |
269 | $c->forward( 'MyApp::View::TT' ); |
270 | |
271 | =cut |
272 | |
273 | around stash => sub { |
274 | my $orig = shift; |
275 | my $c = shift; |
276 | my $stash = $orig->($c); |
277 | if (@_) { |
278 | my $new_stash = @_ > 1 ? {@_} : $_[0]; |
279 | croak('stash takes a hash or hashref') unless ref $new_stash; |
280 | foreach my $key ( keys %$new_stash ) { |
281 | $stash->{$key} = $new_stash->{$key}; |
282 | } |
283 | } |
284 | |
285 | return $stash; |
286 | }; |
287 | |
288 | |
289 | =head2 $c->error |
290 | |
291 | =head2 $c->error($error, ...) |
292 | |
293 | =head2 $c->error($arrayref) |
294 | |
295 | Returns an arrayref containing error messages. If Catalyst encounters an |
296 | error while processing a request, it stores the error in $c->error. This |
297 | method should only be used to store fatal error messages. |
298 | |
299 | my @error = @{ $c->error }; |
300 | |
301 | Add a new error. |
302 | |
303 | $c->error('Something bad happened'); |
304 | |
305 | =cut |
306 | |
307 | sub error { |
308 | my $c = shift; |
309 | if ( $_[0] ) { |
310 | my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; |
311 | croak @$error unless ref $c; |
312 | push @{ $c->{error} }, @$error; |
313 | } |
314 | elsif ( defined $_[0] ) { $c->{error} = undef } |
315 | return $c->{error} || []; |
316 | } |
317 | |
318 | |
319 | =head2 $c->state |
320 | |
321 | Contains the return value of the last executed action. |
322 | Note that << $c->state >> operates in a scalar context which means that all |
323 | values it returns are scalar. |
324 | |
325 | =head2 $c->clear_errors |
326 | |
327 | Clear errors. You probably don't want to clear the errors unless you are |
328 | implementing a custom error screen. |
329 | |
330 | This is equivalent to running |
331 | |
332 | $c->error(0); |
333 | |
334 | =cut |
335 | |
336 | sub clear_errors { |
337 | my $c = shift; |
338 | $c->error(0); |
339 | } |
340 | |
341 | =head2 COMPONENT ACCESSORS |
342 | |
343 | =head2 $c->controller($name) |
344 | |
345 | Gets a L<Catalyst::Controller> instance by name. |
346 | |
347 | $c->controller('Foo')->do_stuff; |
348 | |
349 | If the name is omitted, will return the controller for the dispatched |
350 | action. |
351 | |
352 | If you want to search for controllers, pass in a regexp as the argument. |
353 | |
354 | # find all controllers that start with Foo |
355 | my @foo_controllers = $c->controller(qr{^Foo}); |
356 | |
357 | |
358 | =cut |
359 | |
360 | sub controller { |
361 | my ( $c, $name, @args ) = @_; |
362 | |
363 | if( $name ) { |
364 | my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); |
365 | return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
366 | return $c->_filter_component( $result[ 0 ], @args ); |
367 | } |
368 | |
369 | return $c->component( $c->action->class ); |
370 | } |
371 | |
372 | =head2 $c->model($name) |
373 | |
374 | Gets a L<Catalyst::Model> instance by name. |
375 | |
376 | $c->model('Foo')->do_stuff; |
377 | |
378 | Any extra arguments are directly passed to ACCEPT_CONTEXT. |
379 | |
380 | If the name is omitted, it will look for |
381 | - a model object in $c->stash->{current_model_instance}, then |
382 | - a model name in $c->stash->{current_model}, then |
383 | - a config setting 'default_model', or |
384 | - check if there is only one model, and return it if that's the case. |
385 | |
386 | If you want to search for models, pass in a regexp as the argument. |
387 | |
388 | # find all models that start with Foo |
389 | my @foo_models = $c->model(qr{^Foo}); |
390 | |
391 | =cut |
392 | |
393 | sub model { |
394 | my ( $c, $name, @args ) = @_; |
395 | my $appclass = ref($c) || $c; |
396 | if( $name ) { |
397 | my @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); |
398 | return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
399 | return $c->_filter_component( $result[ 0 ], @args ); |
400 | } |
401 | |
402 | if (ref $c) { |
403 | return $c->stash->{current_model_instance} |
404 | if $c->stash->{current_model_instance}; |
405 | return $c->model( $c->stash->{current_model} ) |
406 | if $c->stash->{current_model}; |
407 | } |
408 | return $c->model( $c->config->{default_model} ) |
409 | if $c->config->{default_model}; |
410 | |
411 | my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); |
412 | |
413 | if( $rest ) { |
414 | $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') ); |
415 | $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' ); |
416 | $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' ); |
417 | $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' ); |
418 | $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); |
419 | } |
420 | |
421 | return $c->_filter_component( $comp ); |
422 | } |
423 | |
424 | |
425 | =head2 $c->view($name) |
426 | |
427 | Gets a L<Catalyst::View> instance by name. |
428 | |
429 | $c->view('Foo')->do_stuff; |
430 | |
431 | Any extra arguments are directly passed to ACCEPT_CONTEXT. |
432 | |
433 | If the name is omitted, it will look for |
434 | - a view object in $c->stash->{current_view_instance}, then |
435 | - a view name in $c->stash->{current_view}, then |
436 | - a config setting 'default_view', or |
437 | - check if there is only one view, and return it if that's the case. |
438 | |
439 | If you want to search for views, pass in a regexp as the argument. |
440 | |
441 | # find all views that start with Foo |
442 | my @foo_views = $c->view(qr{^Foo}); |
443 | |
444 | =cut |
445 | |
446 | sub view { |
447 | my ( $c, $name, @args ) = @_; |
448 | |
449 | my $appclass = ref($c) || $c; |
450 | if( $name ) { |
451 | my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); |
452 | return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
453 | return $c->_filter_component( $result[ 0 ], @args ); |
454 | } |
455 | |
456 | if (ref $c) { |
457 | return $c->stash->{current_view_instance} |
458 | if $c->stash->{current_view_instance}; |
459 | return $c->view( $c->stash->{current_view} ) |
460 | if $c->stash->{current_view}; |
461 | } |
462 | return $c->view( $c->config->{default_view} ) |
463 | if $c->config->{default_view}; |
464 | |
465 | my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/); |
466 | |
467 | if( $rest ) { |
468 | $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' ); |
469 | $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' ); |
470 | $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' ); |
471 | $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' ); |
472 | $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); |
473 | } |
474 | |
475 | return $c->_filter_component( $comp ); |
476 | } |
477 | |
478 | |
479 | |
480 | =head2 $c->uri_for( $path, @args?, \%query_values? ) |
481 | |
482 | =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? ) |
483 | |
484 | Constructs an absolute L<URI> object based on the application root, the |
485 | provided path, and the additional arguments and query parameters provided. |
486 | When used as a string, provides a textual URI. |
487 | |
488 | If the first argument is a string, it is taken as a public URI path relative |
489 | to C<< $c->namespace >> (if it doesn't begin with a forward slash) or |
490 | relative to the application root (if it does). It is then merged with |
491 | C<< $c->request->base >>; any C<@args> are appended as additional path |
492 | components; and any C<%query_values> are appended as C<?foo=bar> parameters. |
493 | |
494 | If the first argument is a L<Catalyst::Action> it represents an action which |
495 | will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The |
496 | optional C<\@captures> argument (an arrayref) allows passing the captured |
497 | variables that are needed to fill in the paths of Chained and Regex actions; |
498 | once the path is resolved, C<uri_for> continues as though a path was |
499 | provided, appending any arguments or parameters and creating an absolute |
500 | URI. |
501 | |
502 | The captures for the current request can be found in |
503 | C<< $c->request->captures >>, and actions can be resolved using |
504 | C<< Catalyst::Controller->action_for($name) >>. If you have a private action |
505 | path, use C<< $c->uri_for_action >> instead. |
506 | |
507 | # Equivalent to $c->req->uri |
508 | $c->uri_for($c->action, $c->req->captures, |
509 | @{ $c->req->args }, $c->req->params); |
510 | |
511 | # For the Foo action in the Bar controller |
512 | $c->uri_for($c->controller('Bar')->action_for('Foo')); |
513 | |
514 | # Path to a static resource |
515 | $c->uri_for('/static/images/logo.png'); |
516 | |
517 | =cut |
518 | |
519 | sub uri_for { |
520 | my ( $c, $path, @args ) = @_; |
521 | |
522 | if (blessed($path) && $path->isa('Catalyst::Controller')) { |
523 | $path = $path->path_prefix; |
524 | $path =~ s{/+\z}{}; |
525 | $path .= '/'; |
526 | } |
527 | |
528 | if ( blessed($path) ) { # action object |
529 | my $captures = ( scalar @args && ref $args[0] eq 'ARRAY' |
530 | ? shift(@args) |
531 | : [] ); |
532 | my $action = $path; |
533 | $path = $c->dispatcher->uri_for_action($action, $captures); |
534 | if (not defined $path) { |
535 | $c->log->debug(qq/Can't find uri_for action '$action' @$captures/) |
536 | if $c->debug; |
537 | return undef; |
538 | } |
539 | $path = '/' if $path eq ''; |
540 | } |
541 | |
542 | undef($path) if (defined $path && $path eq ''); |
543 | |
544 | my $params = |
545 | ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); |
546 | |
547 | carp "uri_for called with undef argument" if grep { ! defined $_ } @args; |
548 | s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; |
549 | |
550 | unshift(@args, $path); |
551 | |
552 | unless (defined $path && $path =~ s!^/!!) { # in-place strip |
553 | my $namespace = $c->namespace; |
554 | if (defined $path) { # cheesy hack to handle path '../foo' |
555 | $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; |
556 | } |
557 | unshift(@args, $namespace || ''); |
558 | } |
559 | |
560 | # join args with '/', or a blank string |
561 | my $args = join('/', grep { defined($_) } @args); |
562 | $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE |
563 | $args =~ s!^/+!!; |
564 | my $base = $c->req->base; |
565 | my $class = ref($base); |
566 | $base =~ s{(?<!/)$}{/}; |
567 | |
568 | my $query = ''; |
569 | |
570 | if (my @keys = keys %$params) { |
571 | # somewhat lifted from URI::_query's query_form |
572 | $query = '?'.join('&', map { |
573 | my $val = $params->{$_}; |
574 | s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; |
575 | s/ /+/g; |
576 | my $key = $_; |
577 | $val = '' unless defined $val; |
578 | (map { |
579 | my $param = "$_"; |
580 | utf8::encode( $param ) if utf8::is_utf8($param); |
581 | # using the URI::Escape pattern here so utf8 chars survive |
582 | $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; |
583 | $param =~ s/ /+/g; |
584 | "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); |
585 | } @keys); |
586 | } |
587 | |
588 | my $res = bless(\"${base}${args}${query}", $class); |
589 | $res; |
590 | } |
591 | |
592 | =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? ) |
593 | |
594 | =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? ) |
595 | |
596 | =over |
597 | |
598 | =item $path |
599 | |
600 | A private path to the Catalyst action you want to create a URI for. |
601 | |
602 | This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path) |
603 | >> and passing the resulting C<$action> and the remaining arguments to C<< |
604 | $c->uri_for >>. |
605 | |
606 | You can also pass in a Catalyst::Action object, in which case it is passed to |
607 | C<< $c->uri_for >>. |
608 | |
609 | =back |
610 | |
611 | =cut |
612 | |
613 | sub uri_for_action { |
614 | my ( $c, $path, @args ) = @_; |
615 | my $action = blessed($path) |
616 | ? $path |
617 | : $c->dispatcher->get_action_by_path($path); |
618 | unless (defined $action) { |
619 | croak "Can't find action for path '$path'"; |
620 | } |
621 | return $c->uri_for( $action, @args ); |
622 | } |
623 | |
624 | |
625 | |
626 | =head1 INTERNAL METHODS |
627 | |
628 | =head2 $c->counter |
629 | |
630 | Returns a hashref containing coderefs and execution counts (needed for |
631 | deep recursion detection). |
632 | |
633 | =head2 $c->depth |
634 | |
635 | Returns the number of actions on the current internal execution stack. |
636 | |
637 | =head2 $c->dump_these |
638 | |
639 | Returns a list of 2-element array references (name, structure) pairs |
640 | that will be dumped on the error page in debug mode. |
641 | |
642 | =cut |
643 | |
644 | sub dump_these { |
645 | my $c = shift; |
646 | [ Request => $c->req ], |
647 | [ Response => $c->res ], |
648 | [ Stash => $c->stash ], |
649 | [ Config => $c->config ]; |
650 | } |
651 | |
652 | |
653 | =head2 $c->execute( $class, $coderef ) |
654 | |
655 | Execute a coderef in given class and catch exceptions. Errors are available |
656 | via $c->error. |
657 | |
658 | =cut |
659 | |
660 | sub execute { |
661 | my ( $c, $class, $code ) = @_; |
662 | $class = $c->component($class) || $class; |
663 | $c->state(0); |
664 | |
665 | if ( $c->depth >= $RECURSION ) { |
666 | my $action = $code->reverse(); |
667 | $action = "/$action" unless $action =~ /->/; |
668 | my $error = qq/Deep recursion detected calling "${action}"/; |
669 | $c->log->error($error); |
670 | $c->error($error); |
671 | $c->state(0); |
672 | return $c->state; |
673 | } |
674 | |
675 | my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats; |
676 | |
677 | push( @{ $c->stack }, $code ); |
678 | |
679 | no warnings 'recursion'; |
680 | eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) }; |
681 | |
682 | $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; |
54642e5a |
683 | |
0a2c51b7 |
684 | my $last = pop( @{ $c->stack } ); |
685 | |
686 | if ( my $error = $@ ) { |
687 | if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { |
688 | $error->rethrow if $c->depth > 1; |
689 | } |
690 | elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) { |
691 | $error->rethrow if $c->depth > 0; |
692 | } |
693 | else { |
694 | unless ( ref $error ) { |
695 | no warnings 'uninitialized'; |
696 | chomp $error; |
697 | my $class = $last->class; |
698 | my $name = $last->name; |
699 | $error = qq/Caught exception in $class->$name "$error"/; |
700 | } |
701 | $c->error($error); |
702 | $c->state(0); |
703 | } |
704 | } |
705 | return $c->state; |
706 | } |
707 | |
708 | sub _stats_start_execute { |
709 | my ( $c, $code ) = @_; |
710 | my $appclass = ref($c) || $c; |
711 | return if ( ( $code->name =~ /^_.*/ ) |
712 | && ( !$c->config->{show_internal_actions} ) ); |
713 | |
714 | my $action_name = $code->reverse(); |
715 | $c->counter->{$action_name}++; |
716 | |
717 | my $action = $action_name; |
718 | $action = "/$action" unless $action =~ /->/; |
719 | |
720 | # determine if the call was the result of a forward |
721 | # this is done by walking up the call stack and looking for a calling |
722 | # sub of Catalyst::forward before the eval |
723 | my $callsub = q{}; |
724 | for my $index ( 2 .. 11 ) { |
725 | last |
726 | if ( ( caller($index) )[0] eq 'Catalyst' |
727 | && ( caller($index) )[3] eq '(eval)' ); |
728 | |
729 | if ( ( caller($index) )[3] =~ /forward$/ ) { |
730 | $callsub = ( caller($index) )[3]; |
731 | $action = "-> $action"; |
732 | last; |
733 | } |
734 | } |
735 | |
736 | my $uid = $action_name . $c->counter->{$action_name}; |
737 | |
738 | # is this a root-level call or a forwarded call? |
739 | if ( $callsub =~ /forward$/ ) { |
740 | my $parent = $c->stack->[-1]; |
741 | |
742 | # forward, locate the caller |
743 | if ( exists $c->counter->{"$parent"} ) { |
744 | $c->stats->profile( |
745 | begin => $action, |
746 | parent => "$parent" . $c->counter->{"$parent"}, |
747 | uid => $uid, |
748 | ); |
749 | } |
750 | else { |
751 | |
752 | # forward with no caller may come from a plugin |
753 | $c->stats->profile( |
754 | begin => $action, |
755 | uid => $uid, |
756 | ); |
757 | } |
758 | } |
759 | else { |
760 | |
761 | # root-level call |
762 | $c->stats->profile( |
763 | begin => $action, |
764 | uid => $uid, |
765 | ); |
766 | } |
767 | return $action; |
768 | |
769 | } |
770 | |
771 | sub _stats_finish_execute { |
772 | my ( $c, $info ) = @_; |
773 | $c->stats->profile( end => $info ); |
774 | } |
775 | |
776 | =head2 $c->finalize |
777 | |
778 | Finalizes the request. |
779 | |
780 | =cut |
781 | |
782 | sub finalize { |
783 | my $c = shift; |
784 | |
785 | for my $error ( @{ $c->error } ) { |
786 | $c->log->error($error); |
787 | } |
788 | |
789 | # Allow engine to handle finalize flow (for POE) |
790 | my $engine = $c->engine; |
791 | if ( my $code = $engine->can('finalize') ) { |
792 | $engine->$code($c); |
793 | } |
794 | else { |
795 | |
796 | $c->finalize_uploads; |
797 | |
798 | # Error |
799 | if ( $#{ $c->error } >= 0 ) { |
800 | $c->finalize_error; |
801 | } |
802 | |
803 | $c->finalize_headers; |
804 | |
805 | # HEAD request |
806 | if ( $c->request->method eq 'HEAD' ) { |
807 | $c->response->body(''); |
808 | } |
809 | |
810 | $c->finalize_body; |
811 | } |
812 | |
813 | if ($c->use_stats) { |
814 | my $elapsed = sprintf '%f', $c->stats->elapsed; |
815 | my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; |
816 | $c->log->info( |
817 | "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); |
818 | } |
819 | |
820 | return $c->response->status; |
821 | } |
822 | |
823 | =head2 $c->finalize_body |
824 | |
825 | Finalizes body. |
826 | |
827 | =cut |
828 | |
829 | sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) } |
830 | |
831 | =head2 $c->finalize_cookies |
832 | |
833 | Finalizes cookies. |
834 | |
835 | =cut |
836 | |
837 | sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) } |
838 | |
839 | =head2 $c->finalize_error |
840 | |
841 | Finalizes error. |
842 | |
843 | =cut |
844 | |
845 | sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) } |
846 | |
847 | =head2 $c->finalize_headers |
848 | |
849 | Finalizes headers. |
850 | |
851 | =cut |
852 | |
853 | sub finalize_headers { |
854 | my $c = shift; |
855 | |
856 | my $response = $c->response; #accessor calls can add up? |
857 | |
858 | # Check if we already finalized headers |
859 | return if $response->finalized_headers; |
860 | |
861 | # Handle redirects |
862 | if ( my $location = $response->redirect ) { |
863 | $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; |
864 | $response->header( Location => $location ); |
865 | |
866 | if ( !$response->has_body ) { |
867 | # Add a default body if none is already present |
868 | $response->body( |
869 | qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>} |
870 | ); |
871 | } |
872 | } |
873 | |
874 | # Content-Length |
875 | if ( $response->body && !$response->content_length ) { |
876 | |
877 | # get the length from a filehandle |
878 | if ( blessed( $response->body ) && $response->body->can('read') ) |
879 | { |
880 | my $stat = stat $response->body; |
881 | if ( $stat && $stat->size > 0 ) { |
882 | $response->content_length( $stat->size ); |
883 | } |
884 | else { |
885 | $c->log->warn('Serving filehandle without a content-length'); |
886 | } |
887 | } |
888 | else { |
889 | # everything should be bytes at this point, but just in case |
890 | $response->content_length( bytes::length( $response->body ) ); |
891 | } |
892 | } |
893 | |
894 | # Errors |
895 | if ( $response->status =~ /^(1\d\d|[23]04)$/ ) { |
896 | $response->headers->remove_header("Content-Length"); |
897 | $response->body(''); |
898 | } |
899 | |
900 | $c->finalize_cookies; |
901 | |
902 | $c->engine->finalize_headers( $c, @_ ); |
903 | |
904 | # Done |
905 | $response->finalized_headers(1); |
906 | } |
907 | |
908 | =head2 $c->finalize_output |
909 | |
910 | An alias for finalize_body. |
911 | |
912 | =head2 $c->finalize_read |
913 | |
914 | Finalizes the input after reading is complete. |
915 | |
916 | =cut |
917 | |
918 | sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) } |
919 | |
920 | =head2 $c->finalize_uploads |
921 | |
922 | Finalizes uploads. Cleans up any temporary files. |
923 | |
924 | =cut |
925 | |
926 | sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) } |
927 | |
928 | =head2 $c->get_action( $action, $namespace ) |
929 | |
930 | Gets an action in a given namespace. |
931 | |
932 | =cut |
933 | |
934 | sub get_action { my $c = shift; $c->dispatcher->get_action(@_) } |
935 | |
936 | =head2 $c->get_actions( $action, $namespace ) |
937 | |
938 | Gets all actions of a given name in a namespace and all parent |
939 | namespaces. |
940 | |
941 | =cut |
942 | |
943 | sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } |
944 | |
945 | =head2 $c->dispatch |
946 | |
947 | Dispatches a request to actions. |
948 | |
949 | =cut |
950 | |
951 | sub dispatch { |
952 | my $c = shift; |
953 | my $dispatcher = $c->dispatcher; |
954 | $dispatcher->dispatch( $c, @_ ) |
955 | } |
956 | |
957 | =head2 $c->prepare_action |
958 | |
959 | Prepares action. See L<Catalyst::Dispatcher>. |
960 | |
961 | =cut |
962 | |
963 | sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) } |
964 | |
965 | =head2 $c->prepare_body |
966 | |
967 | Prepares message body. |
968 | |
969 | =cut |
970 | |
971 | sub prepare_body { |
972 | my $c = shift; |
973 | |
974 | return if $c->request->_has_body; |
975 | |
976 | # Initialize on-demand data |
977 | $c->engine->prepare_body( $c, @_ ); |
978 | $c->prepare_parameters; |
979 | $c->prepare_uploads; |
980 | |
981 | if ( $c->debug && keys %{ $c->req->body_parameters } ) { |
982 | my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); |
983 | for my $key ( sort keys %{ $c->req->body_parameters } ) { |
984 | my $param = $c->req->body_parameters->{$key}; |
985 | my $value = defined($param) ? $param : ''; |
986 | $t->row( $key, |
987 | ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); |
988 | } |
989 | $c->log->debug( "Body Parameters are:\n" . $t->draw ); |
990 | } |
991 | } |
992 | |
993 | =head2 $c->prepare_body_chunk( $chunk ) |
994 | |
995 | Prepares a chunk of data before sending it to L<HTTP::Body>. |
996 | |
997 | See L<Catalyst::Engine>. |
998 | |
999 | =cut |
1000 | |
1001 | sub prepare_body_chunk { |
1002 | my $c = shift; |
1003 | $c->engine->prepare_body_chunk( $c, @_ ); |
1004 | } |
1005 | |
1006 | =head2 $c->prepare_body_parameters |
1007 | |
1008 | Prepares body parameters. |
1009 | |
1010 | =cut |
1011 | |
1012 | sub prepare_body_parameters { |
1013 | my $c = shift; |
1014 | $c->engine->prepare_body_parameters( $c, @_ ); |
1015 | } |
1016 | |
1017 | =head2 $c->prepare_connection |
1018 | |
1019 | Prepares connection. |
1020 | |
1021 | =cut |
1022 | |
1023 | sub prepare_connection { |
1024 | my $c = shift; |
1025 | $c->engine->prepare_connection( $c, @_ ); |
1026 | } |
1027 | |
1028 | =head2 $c->prepare_cookies |
1029 | |
1030 | Prepares cookies. |
1031 | |
1032 | =cut |
1033 | |
1034 | sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) } |
1035 | |
1036 | =head2 $c->prepare_headers |
1037 | |
1038 | Prepares headers. |
1039 | |
1040 | =cut |
1041 | |
1042 | sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) } |
1043 | |
1044 | =head2 $c->prepare_parameters |
1045 | |
1046 | Prepares parameters. |
1047 | |
1048 | =cut |
1049 | |
1050 | sub prepare_parameters { |
1051 | my $c = shift; |
1052 | $c->prepare_body_parameters; |
1053 | $c->engine->prepare_parameters( $c, @_ ); |
1054 | } |
1055 | |
1056 | =head2 $c->prepare_path |
1057 | |
1058 | Prepares path and base. |
1059 | |
1060 | =cut |
1061 | |
1062 | sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) } |
1063 | |
1064 | =head2 $c->prepare_query_parameters |
1065 | |
1066 | Prepares query parameters. |
1067 | |
1068 | =cut |
1069 | |
1070 | sub prepare_query_parameters { |
1071 | my $c = shift; |
1072 | |
1073 | $c->engine->prepare_query_parameters( $c, @_ ); |
1074 | |
1075 | if ( $c->debug && keys %{ $c->request->query_parameters } ) { |
1076 | my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); |
1077 | for my $key ( sort keys %{ $c->req->query_parameters } ) { |
1078 | my $param = $c->req->query_parameters->{$key}; |
1079 | my $value = defined($param) ? $param : ''; |
1080 | $t->row( $key, |
1081 | ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); |
1082 | } |
1083 | $c->log->debug( "Query Parameters are:\n" . $t->draw ); |
1084 | } |
1085 | } |
1086 | |
1087 | =head2 $c->prepare_read |
1088 | |
1089 | Prepares the input for reading. |
1090 | |
1091 | =cut |
1092 | |
1093 | sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) } |
1094 | |
1095 | =head2 $c->prepare_request |
1096 | |
1097 | Prepares the engine request. |
1098 | |
1099 | =cut |
1100 | |
1101 | sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) } |
1102 | |
1103 | =head2 $c->prepare_uploads |
1104 | |
1105 | Prepares uploads. |
1106 | |
1107 | =cut |
1108 | |
1109 | sub prepare_uploads { |
1110 | my $c = shift; |
1111 | |
1112 | $c->engine->prepare_uploads( $c, @_ ); |
1113 | |
1114 | if ( $c->debug && keys %{ $c->request->uploads } ) { |
1115 | my $t = Text::SimpleTable->new( |
1116 | [ 12, 'Parameter' ], |
1117 | [ 26, 'Filename' ], |
1118 | [ 18, 'Type' ], |
1119 | [ 9, 'Size' ] |
1120 | ); |
1121 | for my $key ( sort keys %{ $c->request->uploads } ) { |
1122 | my $upload = $c->request->uploads->{$key}; |
1123 | for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) { |
1124 | $t->row( $key, $u->filename, $u->type, $u->size ); |
1125 | } |
1126 | } |
1127 | $c->log->debug( "File Uploads are:\n" . $t->draw ); |
1128 | } |
1129 | } |
1130 | |
1131 | =head2 $c->prepare_write |
1132 | |
1133 | Prepares the output for writing. |
1134 | |
1135 | =cut |
1136 | |
1137 | sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) } |
1138 | |
1139 | =head2 $c->request_class |
1140 | |
1141 | Returns or sets the request class. |
1142 | |
1143 | =head2 $c->response_class |
1144 | |
1145 | Returns or sets the response class. |
1146 | |
1147 | =head2 $c->read( [$maxlength] ) |
1148 | |
1149 | Reads a chunk of data from the request body. This method is designed to |
1150 | be used in a while loop, reading C<$maxlength> bytes on every call. |
1151 | C<$maxlength> defaults to the size of the request if not specified. |
1152 | |
1153 | You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this |
1154 | directly. |
1155 | |
1156 | Warning: If you use read(), Catalyst will not process the body, |
1157 | so you will not be able to access POST parameters or file uploads via |
1158 | $c->request. You must handle all body parsing yourself. |
1159 | |
1160 | =cut |
1161 | |
1162 | sub read { my $c = shift; return $c->engine->read( $c, @_ ) } |
1163 | |
1164 | =head2 $c->run |
1165 | |
1166 | Starts the engine. |
1167 | |
1168 | =cut |
1169 | |
1170 | sub run { my $c = shift; return $c->engine->run( $c, @_ ) } |
1171 | |
1172 | =head2 $c->stack |
1173 | |
1174 | Returns an arrayref of the internal execution stack (actions that are |
1175 | currently executing). |
1176 | |
1177 | |
1178 | =head2 $c->write( $data ) |
1179 | |
1180 | Writes $data to the output stream. When using this method directly, you |
1181 | will need to manually set the C<Content-Length> header to the length of |
1182 | your output data, if known. |
1183 | |
1184 | =cut |
1185 | |
1186 | sub write { |
1187 | my $c = shift; |
1188 | |
1189 | # Finalize headers if someone manually writes output |
1190 | $c->finalize_headers; |
1191 | |
1192 | return $c->engine->write( $c, @_ ); |
1193 | } |
1194 | |
1195 | |
1196 | no Moose; |
54642e5a |
1197 | __PACKAGE__->meta->make_immutable; |
1198 | |
1199 | 1; |
1200 | |
1201 | __END__ |
1202 | |
1203 | =head1 NAME |
1204 | |
1205 | Catalyst::Context - object for keeping request related state |
1206 | |
1207 | =head1 ATTRIBUTES |
1208 | |
1209 | =head3 action |
1210 | |
1211 | =head3 counter |
1212 | |
1213 | =head3 namespace |
1214 | |
1215 | =head3 request_class |
1216 | |
1217 | =head3 request |
1218 | |
1219 | =head3 response_class |
1220 | |
1221 | =head3 response |
1222 | |
1223 | =head3 stack |
1224 | |
1225 | =head3 stash |
1226 | |
1227 | =head3 state |
1228 | |
1229 | =head3 stats |
1230 | |
1231 | =head1 SEE ALSO |
1232 | |
1233 | L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>. |
1234 | |
1235 | =head1 AUTHORS |
1236 | |
1237 | Catalyst Contributors, see Catalyst.pm |
1238 | |
1239 | =head1 COPYRIGHT |
1240 | |
1241 | This library is free software. You can redistribute it and/or modify it under |
1242 | the same terms as Perl itself. |
1243 | |
1244 | =cut |
1245 | |