fixed docs
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
38e43e65 7use namespace::clean -except => 'meta';
a2f2cde9 8use Catalyst::Exception;
154ef0c8 9use Catalyst::Exception::Detach;
10use Catalyst::Exception::Go;
fc7ec1d9 11use Catalyst::Log;
fbcc39ad 12use Catalyst::Request;
13use Catalyst::Request::Upload;
14use Catalyst::Response;
812a28c9 15use Catalyst::Utils;
31375184 16use Catalyst::Controller;
62b6b631 17use Data::OptList;
364d7324 18use Devel::InnerPackage ();
c50f595c 19use Module::Pluggable::Object ();
c50f595c 20use Text::SimpleTable ();
21use Path::Class::Dir ();
22use Path::Class::File ();
c50f595c 23use URI ();
933ba403 24use URI::http;
25use URI::https;
7af54927 26use HTML::Entities;
5513038d 27use Tree::Simple qw/use_weak_refs/;
28use Tree::Simple::Visitor::FindByUID;
269408a4 29use Class::C3::Adopt::NEXT;
196f06d1 30use List::MoreUtils qw/uniq/;
261c571e 31use attributes;
532f0516 32use String::RewritePrefix;
b1ededd4 33use Catalyst::EngineLoader;
5789a3d8 34use utf8;
108201b5 35use Carp qw/croak carp shortmess/;
3640641e 36use Try::Tiny;
4995a5ce 37use Safe::Isa;
dd5b1dc4 38use Moose::Util 'find_meta';
ad79be34 39use Plack::Middleware::Conditional;
40use Plack::Middleware::ReverseProxy;
fb99321f 41use Plack::Middleware::IIS6ScriptNameFix;
201e0a1f 42use Plack::Middleware::IIS7KeepAliveFix;
d3670826 43use Plack::Middleware::LighttpdScriptNameFix;
aa20e9f5 44use Plack::Middleware::ContentLength;
45use Plack::Middleware::Head;
660f9bb0 46use Plack::Middleware::HTTPExceptions;
ecf903d0 47use Plack::Middleware::FixMissingBodyInRedirect;
3157d22a 48use Plack::Middleware::MethodOverride;
79070bc6 49use Plack::Middleware::RemoveRedundantBody;
6561feae 50use Catalyst::Middleware::Stash;
20a09634 51use Plack::Util;
e7399d8b 52use Class::Load 'load_class';
0ca510f0 53use Encode 2.21 'decode_utf8', 'encode_utf8';
fc7ec1d9 54
0f6be50c 55BEGIN { require 5.008003; }
f63c03e4 56
8a440eba 57has stack => (is => 'ro', default => sub { [] });
6680c772 58has state => (is => 'rw', default => 0);
b6d4ee6e 59has stats => (is => 'rw');
60has action => (is => 'rw');
6680c772 61has counter => (is => 'rw', default => sub { {} });
398f13db 62has request => (
63 is => 'rw',
64 default => sub {
65 my $self = shift;
ec4d7259 66 my $class = ref $self;
67 my $composed_request_class = $class->composed_request_class;
68 return $composed_request_class->new( $self->_build_request_constructor_args);
398f13db 69 },
70 lazy => 1,
71);
a2c6c7b9 72sub _build_request_constructor_args {
0df490ef 73 my $self = shift;
74 my %p = ( _log => $self->log );
75 $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
b87d834e 76 $p{data_handlers} = {$self->registered_data_handlers};
88ba7793 77 $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
78 if $self->config->{use_hash_multivalue_in_request};
0df490ef 79 \%p;
80}
81
ec4d7259 82sub composed_request_class {
83 my $class = shift;
044e7667 84 my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]});
7dac038c 85
86 # For each trait listed, figure out what the namespace is. First we try the $trait
87 # as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try
88 # Catalyst::TraitFor::Request::$trait. If none load, throw error.
89
90 my $trait_ns = 'TraitFor::Request';
91 my @normalized_traits = map {
92 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
93 } @traits;
94
ec4d7259 95 return $class->_composed_request_class ||
7dac038c 96 $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits));
ec4d7259 97}
98
7c1c4dc6 99has response => (
100 is => 'rw',
101 default => sub {
102 my $self = shift;
ec4d7259 103 my $class = ref $self;
104 my $composed_response_class = $class->composed_response_class;
105 return $composed_response_class->new( $self->_build_response_constructor_args);
7c1c4dc6 106 },
107 lazy => 1,
108);
a2c6c7b9 109sub _build_response_constructor_args {
e8361cf8 110 return +{
111 _log => $_[0]->log,
112 encoding => $_[0]->encoding,
113 };
0df490ef 114}
115
ec4d7259 116sub composed_response_class {
117 my $class = shift;
044e7667 118 my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]});
7dac038c 119
120 my $trait_ns = 'TraitFor::Response';
121 my @normalized_traits = map {
122 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
123 } @traits;
124
ec4d7259 125 return $class->_composed_response_class ||
7dac038c 126 $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits));
ec4d7259 127}
128
e63bdf38 129has namespace => (is => 'rw');
130
8767c5a3 131sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 132sub comp { shift->component(@_) }
6680c772 133
134sub req {
6680c772 135 my $self = shift; return $self->request(@_);
136}
137sub res {
6680c772 138 my $self = shift; return $self->response(@_);
139}
fbcc39ad 140
141# For backwards compatibility
0fc2d522 142sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 143
144# For statistics
145our $COUNT = 1;
146our $START = time;
147our $RECURSION = 1000;
154ef0c8 148our $DETACH = Catalyst::Exception::Detach->new;
149our $GO = Catalyst::Exception::Go->new;
fbcc39ad 150
7dac038c 151#I imagine that very few of these really
152#need to be class variables. if any.
b6d4ee6e 153#maybe we should just make them attributes with a default?
fbcc39ad 154__PACKAGE__->mk_classdata($_)
3cec521a 155 for qw/components arguments dispatcher engine log dispatcher_class
1e5dad00 156 engine_loader context_class request_class response_class stats_class
b87d834e 157 setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
ec4d7259 158 _data_handlers _encoding _encode_check finalized_default_middleware
159 request_class_traits response_class_traits stats_class_traits
160 _composed_request_class _composed_response_class _composed_stats_class/;
cb0354c6 161
3cec521a 162__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
3cec521a 163__PACKAGE__->request_class('Catalyst::Request');
164__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 165__PACKAGE__->stats_class('Catalyst::Stats');
ec4d7259 166
167sub composed_stats_class {
168 my $class = shift;
044e7667 169 my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]});
7dac038c 170
171 my $trait_ns = 'TraitFor::Stats';
172 my @normalized_traits = map {
173 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
174 } @traits;
175
ec4d7259 176 return $class->_composed_stats_class ||
7dac038c 177 $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits));
ec4d7259 178}
179
9c38cb50 180__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
fbcc39ad 181
6415bb4d 182# Remember to update this in Catalyst::Runtime as well!
ed5a562b 183our $VERSION = '5.90096';
5c779e98 184$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
189e2a51 185
fbcc39ad 186sub import {
187 my ( $class, @arguments ) = @_;
188
189 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
190 # callers @ISA.
191 return unless $class eq 'Catalyst';
192
84ff88cf 193 my $caller = caller();
194 return if $caller eq 'main';
269408a4 195
84ff88cf 196 my $meta = Moose::Meta::Class->initialize($caller);
fbcc39ad 197 unless ( $caller->isa('Catalyst') ) {
84ff88cf 198 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
199 $meta->superclasses(@superclasses);
200 }
1cad29ab 201 # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
202 $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
203
84ff88cf 204 unless( $meta->has_method('meta') ){
9c74923d 205 if ($Moose::VERSION >= 1.15) {
206 $meta->_add_meta_method('meta');
207 }
208 else {
209 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
210 }
fbcc39ad 211 }
212
213 $caller->arguments( [@arguments] );
214 $caller->setup_home;
215}
fc7ec1d9 216
e6bfaa20 217sub _application { $_[0] }
218
bf590d36 219=encoding UTF-8
220
fc7ec1d9 221=head1 NAME
222
223Catalyst - The Elegant MVC Web Application Framework
224
9e7f288e 225=for html
226<a href="https://badge.fury.io/pl/Catalyst-Runtime"><img src="https://badge.fury.io/pl/Catalyst-Runtime.svg" alt="CPAN version" height="18"></a>
227<a href="https://travis-ci.org/perl-catalyst/catalyst-runtime/"><img src="https://api.travis-ci.org/perl-catalyst/catalyst-runtime.png" alt="Catalyst></a>
228<a href="http://cpants.cpanauthors.org/dist/Catalyst-Runtime"><img src="http://cpants.cpanauthors.org/dist/Catalyst-Runtime.png" alt='Kwalitee Score' /></a>
229
fc7ec1d9 230=head1 SYNOPSIS
231
e7ad3b81 232See the L<Catalyst::Manual> distribution for comprehensive
233documentation and tutorials.
234
86418559 235 # Install Catalyst::Devel for helpers and other development tools
b4b01a8a 236 # use the helper to create a new application
91864987 237 catalyst.pl MyApp
fc7ec1d9 238
239 # add models, views, controllers
2f381252 240 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
cc95842f 241 script/myapp_create.pl view MyTemplate TT
0ef52a96 242 script/myapp_create.pl controller Search
fc7ec1d9 243
e7f1cf73 244 # built in testserver -- use -r to restart automatically on changes
cc95842f 245 # --help to see all available options
ae4e40a7 246 script/myapp_server.pl
fc7ec1d9 247
0ef52a96 248 # command line testing interface
ae4e40a7 249 script/myapp_test.pl /yada
fc7ec1d9 250
b4b01a8a 251 ### in lib/MyApp.pm
0ef52a96 252 use Catalyst qw/-Debug/; # include plugins here as well
62a6df80 253
85d9fce6 254 ### In lib/MyApp/Controller/Root.pm (autocreated)
20f0d47b 255 sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
ae1e6b59 256 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
257 $c->stash->{template} = 'foo.tt'; # set the template
0ef52a96 258 # lookup something from db -- stash vars are passed to TT
62a6df80 259 $c->stash->{data} =
b4b01a8a 260 $c->model('Database::Foo')->search( { country => $args[0] } );
0ef52a96 261 if ( $c->req->params->{bar} ) { # access GET or POST parameters
262 $c->forward( 'bar' ); # process another action
62a6df80 263 # do something else after forward returns
0ef52a96 264 }
265 }
62a6df80 266
ae1e6b59 267 # The foo.tt TT template can use the stash data from the database
0ef52a96 268 [% WHILE (item = data.next) %]
269 [% item.foo %]
270 [% END %]
62a6df80 271
0ef52a96 272 # called for /bar/of/soap, /bar/of/soap/10, etc.
20f0d47b 273 sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
62a6df80 274
ae1e6b59 275 # called after all actions are finished
20f0d47b 276 sub end : Action {
5a8ed4fe 277 my ( $self, $c ) = @_;
0ef52a96 278 if ( scalar @{ $c->error } ) { ... } # handle errors
279 return if $c->res->body; # already have a response
280 $c->forward( 'MyApp::View::TT' ); # render template
5a8ed4fe 281 }
282
0ef52a96 283See L<Catalyst::Manual::Intro> for additional information.
3803e98f 284
fc7ec1d9 285=head1 DESCRIPTION
286
86418559 287Catalyst is a modern framework for making web applications without the
288pain usually associated with this process. This document is a reference
289to the main Catalyst application. If you are a new user, we suggest you
290start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
fc7ec1d9 291
292See L<Catalyst::Manual> for more documentation.
293
ae1e6b59 294Catalyst plugins can be loaded by naming them as arguments to the "use
295Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
296plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
297C<My::Module>.
fc7ec1d9 298
0ef52a96 299 use Catalyst qw/My::Module/;
fc7ec1d9 300
836e1134 301If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
302fully qualify the name by using a unary plus:
303
304 use Catalyst qw/
305 My::Module
306 +Fully::Qualified::Plugin::Name
307 /;
308
5853fd49 309Special flags like C<-Debug> can also be specified as
ae1e6b59 310arguments when Catalyst is loaded:
fc7ec1d9 311
312 use Catalyst qw/-Debug My::Module/;
313
ae1e6b59 314The position of plugins and flags in the chain is important, because
86418559 315they are loaded in the order in which they appear.
fc7ec1d9 316
23f9d934 317The following flags are supported:
318
b5ecfcf0 319=head2 -Debug
23f9d934 320
f8ad6ea5 321Enables debug output. You can also force this setting from the system
86418559 322environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
323settings override the application, with <MYAPP>_DEBUG having the highest
324priority.
fc7ec1d9 325
c8083f4e 326This sets the log level to 'debug' and enables full debug output on the
327error screen. If you only want the latter, see L<< $c->debug >>.
328
b5ecfcf0 329=head2 -Home
fbcc39ad 330
ae1e6b59 331Forces Catalyst to use a specific home directory, e.g.:
332
86418559 333 use Catalyst qw[-Home=/usr/mst];
fbcc39ad 334
cc95842f 335This can also be done in the shell environment by setting either the
336C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
337is replaced with the uppercased name of your application, any "::" in
338the name will be replaced with underscores, e.g. MyApp::Web should use
339MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
340
d7a82605 341If none of these are set, Catalyst will attempt to automatically detect the
8ad6fd58 342home directory. If you are working in a development environment, Catalyst
a943d722 343will try and find the directory containing either Makefile.PL, Build.PL,
344dist.ini, or cpanfile. If the application has been installed into the system
345(i.e. you have done C<make install>), then Catalyst will use the path to your
8ad6fd58 346application module, without the .pm extension (e.g., /foo/MyApp if your
d7a82605 347application was installed at /foo/MyApp.pm)
348
b5ecfcf0 349=head2 -Log
fbcc39ad 350
0fa676a7 351 use Catalyst '-Log=warn,fatal,error';
62a6df80 352
0fa676a7 353Specifies a comma-delimited list of log levels.
fbcc39ad 354
dc5f035e 355=head2 -Stats
356
01c5eab0 357Enables statistics collection and reporting.
dc5f035e 358
01c5eab0 359 use Catalyst qw/-Stats=1/;
dc5f035e 360
01c5eab0 361You can also force this setting from the system environment with CATALYST_STATS
362or <MYAPP>_STATS. The environment settings override the application, with
363<MYAPP>_STATS having the highest priority.
dc5f035e 364
01c5eab0 365Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
dc5f035e 366
23f9d934 367=head1 METHODS
368
f7b672ef 369=head2 INFORMATION ABOUT THE CURRENT REQUEST
0ef52a96 370
b5ecfcf0 371=head2 $c->action
66e28e3f 372
ae1e6b59 373Returns a L<Catalyst::Action> object for the current action, which
374stringifies to the action name. See L<Catalyst::Action>.
0ef52a96 375
b5ecfcf0 376=head2 $c->namespace
0ef52a96 377
86418559 378Returns the namespace of the current action, i.e., the URI prefix
ae1e6b59 379corresponding to the controller of the current action. For example:
380
381 # in Controller::Foo::Bar
382 $c->namespace; # returns 'foo/bar';
0ef52a96 383
b5ecfcf0 384=head2 $c->request
0ef52a96 385
b5ecfcf0 386=head2 $c->req
0ef52a96 387
86418559 388Returns the current L<Catalyst::Request> object, giving access to
389information about the current client request (including parameters,
390cookies, HTTP headers, etc.). See L<Catalyst::Request>.
0ef52a96 391
b4b01a8a 392=head2 REQUEST FLOW HANDLING
0ef52a96 393
b5ecfcf0 394=head2 $c->forward( $action [, \@arguments ] )
0ef52a96 395
b5ecfcf0 396=head2 $c->forward( $class, $method, [, \@arguments ] )
0ef52a96 397
52c77837 398This is one way of calling another action (method) in the same or
399a different controller. You can also use C<< $self->my_method($c, @args) >>
400in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
401in a different controller.
402The main difference is that 'forward' uses some of the Catalyst request
403cycle overhead, including debugging, which may be useful to you. On the
404other hand, there are some complications to using 'forward', restrictions
405on values returned from 'forward', and it may not handle errors as you prefer.
406Whether you use 'forward' or not is up to you; it is not considered superior to
407the other ways to call a method.
408
409'forward' calls another action, by its private name. If you give a
b4b01a8a 410class name but no method, C<process()> is called. You may also optionally
411pass arguments in an arrayref. The action will receive the arguments in
cc95842f 412C<@_> and C<< $c->req->args >>. Upon returning from the function,
413C<< $c->req->args >> will be restored to the previous values.
0ef52a96 414
3b984c64 415Any data C<return>ed from the action forwarded to, will be returned by the
d759db1e 416call to forward.
3b984c64 417
418 my $foodata = $c->forward('/foo');
0ef52a96 419 $c->forward('index');
1d3a0700 420 $c->forward(qw/Model::DBIC::Foo do_stuff/);
421 $c->forward('View::TT');
0ef52a96 422
18a9655c 423Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
424an C<< eval { } >> around the call (actually
8ad6fd58 425L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
426exceptions thrown by the called action non-fatal and pushing them onto
427$c->error instead. If you want C<die> to propagate you need to do something
428like:
f3e6a8c0 429
430 $c->forward('foo');
7d6820cc 431 die join "\n", @{ $c->error } if @{ $c->error };
f3e6a8c0 432
86418559 433Or make sure to always return true values from your actions and write
434your code like this:
f3e6a8c0 435
436 $c->forward('foo') || return;
1d3a0700 437
2e60292e 438Another note is that C<< $c->forward >> always returns a scalar because it
439actually returns $c->state which operates in a scalar context.
440Thus, something like:
441
442 return @array;
1d3a0700 443
444in an action that is forwarded to is going to return a scalar,
2e60292e 445i.e. how many items are in that array, which is probably not what you want.
1d3a0700 446If you need to return an array then return a reference to it,
2e60292e 447or stash it like so:
448
449 $c->stash->{array} = \@array;
450
451and access it from the stash.
f3e6a8c0 452
9c74923d 453Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
454
0ef52a96 455=cut
456
6680c772 457sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
0ef52a96 458
b5ecfcf0 459=head2 $c->detach( $action [, \@arguments ] )
0ef52a96 460
b5ecfcf0 461=head2 $c->detach( $class, $method, [, \@arguments ] )
0ef52a96 462
264bac8c 463=head2 $c->detach()
464
18a9655c 465The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
466doesn't return to the previous action when processing is finished.
0ef52a96 467
264bac8c 468When called with no arguments it escapes the processing chain entirely.
469
0ef52a96 470=cut
471
472sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
473
8431b9cc 474=head2 $c->visit( $action [, \@arguments ] )
475
5d91ffe2 476=head2 $c->visit( $action [, \@captures, \@arguments ] )
ae0e35ee 477
8431b9cc 478=head2 $c->visit( $class, $method, [, \@arguments ] )
479
5d91ffe2 480=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
ae0e35ee 481
18a9655c 482Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
483but does a full dispatch, instead of just calling the new C<$action> /
484C<< $class->$method >>. This means that C<begin>, C<auto> and the method
485you go to are called, just like a new request.
ae0e35ee 486
4b48773e 487In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
18a9655c 488This means, for example, that C<< $c->action >> methods such as
489L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
490L<reverse|Catalyst::Action/reverse> return information for the visited action
491when they are invoked within the visited action. This is different from the
492behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
493continues to use the $c->action object from the caller action even when
8ad6fd58 494invoked from the called action.
4b48773e 495
18a9655c 496C<< $c->stash >> is kept unchanged.
ae0e35ee 497
18a9655c 498In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
499allows you to "wrap" another action, just as it would have been called by
500dispatching from a URL, while the analogous
501L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
502transfer control to another action as if it had been reached directly from a URL.
ae0e35ee 503
504=cut
505
506sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
507
8431b9cc 508=head2 $c->go( $action [, \@arguments ] )
509
5d91ffe2 510=head2 $c->go( $action [, \@captures, \@arguments ] )
2f381252 511
8431b9cc 512=head2 $c->go( $class, $method, [, \@arguments ] )
513
5d91ffe2 514=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
2f381252 515
1d3a0700 516The relationship between C<go> and
12c48597 517L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
1d3a0700 518the relationship between
12c48597 519L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
520L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
521C<< $c->go >> will perform a full dispatch on the specified action or method,
522with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
523C<go> escapes the processing of the current request chain on completion, and
f380e881 524does not return to its caller.
2f381252 525
9c74923d 526@arguments are arguments to the final destination of $action. @captures are
527arguments to the intermediate steps, if any, on the way to the final sub of
528$action.
529
2f381252 530=cut
531
532sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
533
b4b01a8a 534=head2 $c->response
535
536=head2 $c->res
537
cc95842f 538Returns the current L<Catalyst::Response> object, see there for details.
b4b01a8a 539
540=head2 $c->stash
541
542Returns a hashref to the stash, which may be used to store data and pass
543it between components during a request. You can also set hash keys by
544passing arguments. The stash is automatically sent to the view. The
545stash is cleared at the end of a request; it cannot be used for
86418559 546persistent storage (for this you must use a session; see
547L<Catalyst::Plugin::Session> for a complete system integrated with
548Catalyst).
b4b01a8a 549
550 $c->stash->{foo} = $bar;
551 $c->stash( { moose => 'majestic', qux => 0 } );
552 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
62a6df80 553
b4b01a8a 554 # stash is automatically passed to the view for use in a template
cc95842f 555 $c->forward( 'MyApp::View::TT' );
b4b01a8a 556
4b0b7489 557The stash hash is currently stored in the PSGI C<$env> and is managed by
558L<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in
559the stash can be accessed in sub applications mounted under your main
560L<Catalyst> application. For example if you delegate the response of an
561action to another L<Catalyst> application, that sub application will have
562access to all the stash keys of the main one, and if can of course add
563more keys of its own. However those new keys will not 'bubble' back up
564to the main application.
565
566For more information the best thing to do is to review the test case:
567t/middleware-stash.t in the distribution /t directory.
568
6561feae 569=cut
570
571sub stash {
572 my $c = shift;
98d049ef 573 $c->log->error("You are requesting the stash but you don't have a context") unless blessed $c;
561098d1 574 return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
6561feae 575}
b4b01a8a 576
b5ecfcf0 577=head2 $c->error
0ef52a96 578
b5ecfcf0 579=head2 $c->error($error, ...)
0ef52a96 580
b5ecfcf0 581=head2 $c->error($arrayref)
0ef52a96 582
83a8fcac 583Returns an arrayref containing error messages. If Catalyst encounters an
584error while processing a request, it stores the error in $c->error. This
e7ad3b81 585method should only be used to store fatal error messages.
0ef52a96 586
587 my @error = @{ $c->error };
588
589Add a new error.
590
591 $c->error('Something bad happened');
592
b94f8e72 593Calling this will always return an arrayref (if there are no errors it
594will be an empty arrayref.
595
0ef52a96 596=cut
597
598sub error {
599 my $c = shift;
600 if ( $_[0] ) {
601 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
9ce44430 602 croak @$error unless ref $c;
0ef52a96 603 push @{ $c->{error} }, @$error;
604 }
605 elsif ( defined $_[0] ) { $c->{error} = undef }
606 return $c->{error} || [];
607}
608
b4b01a8a 609
610=head2 $c->state
611
1d3a0700 612Contains the return value of the last executed action.
2e60292e 613Note that << $c->state >> operates in a scalar context which means that all
614values it returns are scalar.
b4b01a8a 615
ca81eb67 616=head2 $c->clear_errors
617
618Clear errors. You probably don't want to clear the errors unless you are
619implementing a custom error screen.
620
621This is equivalent to running
622
623 $c->error(0);
624
625=cut
626
627sub clear_errors {
628 my $c = shift;
629 $c->error(0);
630}
631
30e84ba1 632=head2 $c->has_errors
633
634Returns true if you have errors
635
636=cut
637
638sub has_errors { scalar(@{shift->error}) ? 1:0 }
639
b94f8e72 640=head2 $c->last_error
641
642Returns the most recent error in the stack (the one most recently added...)
e5ac67e5 643or nothing if there are no errors. This does not modify the contents of the
644error stack.
b94f8e72 645
646=cut
647
e5ac67e5 648sub last_error {
649 my (@errs) = @{shift->error};
650 return scalar(@errs) ? $errs[-1]: undef;
651}
b94f8e72 652
653=head2 shift_errors
654
e5ac67e5 655shifts the most recently added error off the error stack and returns it. Returns
566678d0 656nothing if there are no more errors.
b94f8e72 657
658=cut
659
660sub shift_errors {
661 my ($self) = @_;
e5ac67e5 662 my @errors = @{$self->error};
663 my $err = shift(@errors);
664 $self->{error} = \@errors;
665 return $err;
666}
667
668=head2 pop_errors
669
670pops the most recently added error off the error stack and returns it. Returns
671nothing if there are no more errors.
672
673=cut
674
675sub pop_errors {
676 my ($self) = @_;
677 my @errors = @{$self->error};
678 my $err = pop(@errors);
b94f8e72 679 $self->{error} = \@errors;
680 return $err;
681}
682
2f381252 683sub _comp_search_prefixes {
c23b894b 684 my $c = shift;
685 return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
686}
687
688# search components given a name and some prefixes
689sub _comp_names_search_prefixes {
2f381252 690 my ( $c, $name, @prefixes ) = @_;
691 my $appclass = ref $c || $c;
692 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
cce626ed 693 $filter = qr/$filter/; # Compile regex now rather than once per loop
0ef52a96 694
2f381252 695 # map the original component name to the sub part that we will search against
696 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
697 grep { /$filter/ } keys %{ $c->components };
0756fe3b 698
2f381252 699 # undef for a name will return all
700 return keys %eligible if !defined $name;
0756fe3b 701
4995a5ce 702 my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
2f381252 703 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
0756fe3b 704
c23b894b 705 return @result if @result;
0756fe3b 706
2f381252 707 # if we were given a regexp to search against, we're done.
4995a5ce 708 return if $name->$_isa('Regexp');
0756fe3b 709
ab86b480 710 # skip regexp fallback if configured
711 return
712 if $appclass->config->{disable_component_resolution_regex_fallback};
713
2f381252 714 # regexp fallback
715 $query = qr/$name/i;
c23b894b 716 @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
0756fe3b 717
2f381252 718 # no results? try against full names
719 if( !@result ) {
c23b894b 720 @result = grep { m{$query} } keys %eligible;
2f381252 721 }
0756fe3b 722
2f381252 723 # don't warn if we didn't find any results, it just might not exist
724 if( @result ) {
cce626ed 725 # Disgusting hack to work out correct method name
726 my $warn_for = lc $prefixes[0];
e260802a 727 my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
108201b5 728 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
729 "component resolution is unreliable and unsafe.";
730 my $short = $result[0];
ab86b480 731 # remove the component namespace prefix
732 $short =~ s/.*?(Model|Controller|View):://;
108201b5 733 my $shortmess = Carp::shortmess('');
734 if ($shortmess =~ m#Catalyst/Plugin#) {
735 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
736 "plugin's config";
737 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
738 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
739 "component's config";
740 } else {
ab86b480 741 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
108201b5 742 "but if you really wanted to search, pass in a regexp as the argument " .
cce626ed 743 "like so: \$c->${warn_for}(qr/${name}/)";
108201b5 744 }
745 $c->log->warn( "${msg}$shortmess" );
2f381252 746 }
0756fe3b 747
2f381252 748 return @result;
0756fe3b 749}
750
62a6df80 751# Find possible names for a prefix
3b88a455 752sub _comp_names {
753 my ( $c, @prefixes ) = @_;
3b88a455 754 my $appclass = ref $c || $c;
755
2f381252 756 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
3b88a455 757
c23b894b 758 my @names = map { s{$filter}{}; $_; }
759 $c->_comp_names_search_prefixes( undef, @prefixes );
760
3b88a455 761 return @names;
762}
763
197bd788 764# Filter a component before returning by calling ACCEPT_CONTEXT if available
e39312ba 765
197bd788 766sub _filter_component {
767 my ( $c, $comp, @args ) = @_;
2f381252 768
3e560748 769 if(ref $comp eq 'CODE') {
98d049ef 770 $comp = $comp->();
3e560748 771 }
772
8abaac85 773 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
718a1619 774 return $comp->ACCEPT_CONTEXT( $c, @args );
197bd788 775 }
62a6df80 776
3e560748 777 $c->log->warn("You called component '${\$comp->catalyst_component_name}' with arguments [@args], but this component does not ACCEPT_CONTEXT, so args are ignored.") if scalar(@args) && $c->debug;
778
2f381252 779 return $comp;
197bd788 780}
781
f7b672ef 782=head2 COMPONENT ACCESSORS
0ef52a96 783
b5ecfcf0 784=head2 $c->controller($name)
af3ff00e 785
0ef52a96 786Gets a L<Catalyst::Controller> instance by name.
af3ff00e 787
788 $c->controller('Foo')->do_stuff;
789
86418559 790If the name is omitted, will return the controller for the dispatched
791action.
649fd1fa 792
2f381252 793If you want to search for controllers, pass in a regexp as the argument.
794
795 # find all controllers that start with Foo
796 my @foo_controllers = $c->controller(qr{^Foo});
797
798
af3ff00e 799=cut
800
801sub controller {
197bd788 802 my ( $c, $name, @args ) = @_;
2f381252 803
13311c16 804 my $appclass = ref($c) || $c;
2f381252 805 if( $name ) {
4995a5ce 806 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 807 my $comps = $c->components;
808 my $check = $appclass."::Controller::".$name;
809 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
810 }
2f381252 811 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
812 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
813 return $c->_filter_component( $result[ 0 ], @args );
814 }
815
197bd788 816 return $c->component( $c->action->class );
af3ff00e 817}
818
b5ecfcf0 819=head2 $c->model($name)
fc7ec1d9 820
0ef52a96 821Gets a L<Catalyst::Model> instance by name.
822
823 $c->model('Foo')->do_stuff;
fc7ec1d9 824
3e560748 825Any extra arguments are directly passed to ACCEPT_CONTEXT, if the model
826defines ACCEPT_CONTEXT. If it does not, the args are discarded.
72f87c4b 827
62a6df80 828If the name is omitted, it will look for
2f381252 829 - a model object in $c->stash->{current_model_instance}, then
a3b71f0f 830 - a model name in $c->stash->{current_model}, then
831 - a config setting 'default_model', or
832 - check if there is only one model, and return it if that's the case.
649fd1fa 833
2f381252 834If you want to search for models, pass in a regexp as the argument.
835
836 # find all models that start with Foo
837 my @foo_models = $c->model(qr{^Foo});
838
fc7ec1d9 839=cut
840
0ef52a96 841sub model {
197bd788 842 my ( $c, $name, @args ) = @_;
df960201 843 my $appclass = ref($c) || $c;
2f381252 844 if( $name ) {
4995a5ce 845 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 846 my $comps = $c->components;
847 my $check = $appclass."::Model::".$name;
848 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
849 }
2f381252 850 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
851 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
852 return $c->_filter_component( $result[ 0 ], @args );
853 }
854
a3b71f0f 855 if (ref $c) {
62a6df80 856 return $c->stash->{current_model_instance}
a3b71f0f 857 if $c->stash->{current_model_instance};
858 return $c->model( $c->stash->{current_model} )
859 if $c->stash->{current_model};
a3b71f0f 860 }
df960201 861 return $c->model( $appclass->config->{default_model} )
862 if $appclass->config->{default_model};
3b88a455 863
2f381252 864 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
3b88a455 865
2f381252 866 if( $rest ) {
108201b5 867 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
4600a5a1 868 $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
2f381252 869 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
870 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
11c270bd 871 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 872 }
3b88a455 873
2f381252 874 return $c->_filter_component( $comp );
3b88a455 875}
876
b4b01a8a 877
b5ecfcf0 878=head2 $c->view($name)
0ef52a96 879
880Gets a L<Catalyst::View> instance by name.
fc7ec1d9 881
0ef52a96 882 $c->view('Foo')->do_stuff;
fc7ec1d9 883
72f87c4b 884Any extra arguments are directly passed to ACCEPT_CONTEXT.
885
62a6df80 886If the name is omitted, it will look for
2f381252 887 - a view object in $c->stash->{current_view_instance}, then
a3b71f0f 888 - a view name in $c->stash->{current_view}, then
889 - a config setting 'default_view', or
890 - check if there is only one view, and return it if that's the case.
649fd1fa 891
2f381252 892If you want to search for views, pass in a regexp as the argument.
893
894 # find all views that start with Foo
895 my @foo_views = $c->view(qr{^Foo});
896
fc7ec1d9 897=cut
898
0ef52a96 899sub view {
197bd788 900 my ( $c, $name, @args ) = @_;
2f381252 901
df960201 902 my $appclass = ref($c) || $c;
2f381252 903 if( $name ) {
4995a5ce 904 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 905 my $comps = $c->components;
906 my $check = $appclass."::View::".$name;
9c74923d 907 if( exists $comps->{$check} ) {
908 return $c->_filter_component( $comps->{$check}, @args );
909 }
910 else {
911 $c->log->warn( "Attempted to use view '$check', but does not exist" );
912 }
13311c16 913 }
2f381252 914 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
915 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
916 return $c->_filter_component( $result[ 0 ], @args );
917 }
918
a3b71f0f 919 if (ref $c) {
62a6df80 920 return $c->stash->{current_view_instance}
a3b71f0f 921 if $c->stash->{current_view_instance};
922 return $c->view( $c->stash->{current_view} )
923 if $c->stash->{current_view};
a3b71f0f 924 }
df960201 925 return $c->view( $appclass->config->{default_view} )
926 if $appclass->config->{default_view};
2f381252 927
928 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
929
930 if( $rest ) {
931 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
4600a5a1 932 $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
2f381252 933 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
934 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
11c270bd 935 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 936 }
937
938 return $c->_filter_component( $comp );
939}
940
941=head2 $c->controllers
942
943Returns the available names which can be passed to $c->controller
944
945=cut
946
947sub controllers {
948 my ( $c ) = @_;
949 return $c->_comp_names(qw/Controller C/);
0ef52a96 950}
fbcc39ad 951
b4b01a8a 952=head2 $c->models
953
954Returns the available names which can be passed to $c->model
955
956=cut
957
958sub models {
959 my ( $c ) = @_;
960 return $c->_comp_names(qw/Model M/);
961}
962
963
3b88a455 964=head2 $c->views
965
966Returns the available names which can be passed to $c->view
967
968=cut
969
970sub views {
971 my ( $c ) = @_;
972 return $c->_comp_names(qw/View V/);
973}
974
b4b01a8a 975=head2 $c->comp($name)
976
977=head2 $c->component($name)
978
cc95842f 979Gets a component object by name. This method is not recommended,
b4b01a8a 980unless you want to get a specific component by full
cc95842f 981class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
b4b01a8a 982should be used instead.
983
2f381252 984If C<$name> is a regexp, a list of components matched against the full
985component name will be returned.
986
ab86b480 987If Catalyst can't find a component by name, it will fallback to regex
988matching by default. To disable this behaviour set
989disable_component_resolution_regex_fallback to a true value.
1d3a0700 990
220f4575 991 __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
ab86b480 992
b4b01a8a 993=cut
994
995sub component {
2f381252 996 my ( $c, $name, @args ) = @_;
b4b01a8a 997
2f381252 998 if( $name ) {
999 my $comps = $c->components;
b4b01a8a 1000
2f381252 1001 if( !ref $name ) {
1002 # is it the exact name?
1003 return $c->_filter_component( $comps->{ $name }, @args )
1004 if exists $comps->{ $name };
b4b01a8a 1005
2f381252 1006 # perhaps we just omitted "MyApp"?
1007 my $composed = ( ref $c || $c ) . "::${name}";
1008 return $c->_filter_component( $comps->{ $composed }, @args )
1009 if exists $comps->{ $composed };
b4b01a8a 1010
2f381252 1011 # search all of the models, views and controllers
1012 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
1013 return $c->_filter_component( $comp, @args ) if $comp;
1014 }
1015
f899107d 1016 return
1017 if $c->config->{disable_component_resolution_regex_fallback};
1018
2f381252 1019 # This is here so $c->comp( '::M::' ) works
1020 my $query = ref $name ? $name : qr{$name}i;
b4b01a8a 1021
2f381252 1022 my @result = grep { m{$query} } keys %{ $c->components };
1023 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
b4b01a8a 1024
2f381252 1025 if( $result[ 0 ] ) {
108201b5 1026 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
2f381252 1027 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
1028 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
1029 return $c->_filter_component( $result[ 0 ], @args );
1030 }
1031
1032 # I would expect to return an empty list here, but that breaks back-compat
b4b01a8a 1033 }
1034
2f381252 1035 # fallback
b4b01a8a 1036 return sort keys %{ $c->components };
1037}
1038
b4b01a8a 1039=head2 CLASS DATA AND HELPER CLASSES
fbcc39ad 1040
b5ecfcf0 1041=head2 $c->config
fbcc39ad 1042
0ef52a96 1043Returns or takes a hashref containing the application's configuration.
1044
61b1d329 1045 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
81557adf 1046
18a9655c 1047You can also use a C<YAML>, C<XML> or L<Config::General> config file
1048like C<myapp.conf> in your applications home directory. See
cc95842f 1049L<Catalyst::Plugin::ConfigLoader>.
a6ad13b6 1050
6df30f7e 1051=head3 Cascading configuration
a6ad13b6 1052
b3542016 1053The config method is present on all Catalyst components, and configuration
1054will be merged when an application is started. Configuration loaded with
1055L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
62a6df80 1056followed by configuration in your top level C<MyApp> class. These two
a51d14ff 1057configurations are merged, and then configuration data whose hash key matches a
b3542016 1058component name is merged with configuration for that component.
1059
1060The configuration for a component is then passed to the C<new> method when a
1061component is constructed.
1062
1063For example:
1064
1065 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
790ff9aa 1066 MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
62a6df80 1067
1068will mean that C<MyApp::Model::Foo> receives the following data when
b3542016 1069constructed:
1070
1071 MyApp::Model::Foo->new({
1072 bar => 'baz',
1073 quux => 'frob',
1074 overrides => 'me',
1075 });
b4b01a8a 1076
f8a54681 1077It's common practice to use a Moose attribute
1078on the receiving component to access the config value.
1079
1080 package MyApp::Model::Foo;
1081
1082 use Moose;
1083
1084 # this attr will receive 'baz' at construction time
9c74923d 1085 has 'bar' => (
f8a54681 1086 is => 'rw',
1087 isa => 'Str',
1088 );
1089
1090You can then get the value 'baz' by calling $c->model('Foo')->bar
9c74923d 1091(or $self->bar inside code in the model).
1092
1093B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
1094as a way of reading config within your code, as this B<will not> give you the
1095correctly merged config back. You B<MUST> take the config values supplied to
1096the constructor and use those instead.
f8a54681 1097
3643e890 1098=cut
1099
4090e3bb 1100around config => sub {
1101 my $orig = shift;
3643e890 1102 my $c = shift;
1103
fcf89172 1104 croak('Setting config after setup has been run is not allowed.')
1105 if ( @_ and $c->setup_finished );
3643e890 1106
4090e3bb 1107 $c->$orig(@_);
1108};
3643e890 1109
b5ecfcf0 1110=head2 $c->log
0ef52a96 1111
86418559 1112Returns the logging object instance. Unless it is already set, Catalyst
1113sets this up with a L<Catalyst::Log> object. To use your own log class,
1114set the logger with the C<< __PACKAGE__->log >> method prior to calling
9e7673af 1115C<< __PACKAGE__->setup >>.
1116
1117 __PACKAGE__->log( MyLogger->new );
1118 __PACKAGE__->setup;
1119
1120And later:
0ef52a96 1121
ae1e6b59 1122 $c->log->info( 'Now logging with my own logger!' );
0ef52a96 1123
86418559 1124Your log class should implement the methods described in
1125L<Catalyst::Log>.
af3ff00e 1126
6adc45cf 1127=head2 has_encoding
1128
1129Returned True if there's a valid encoding
1130
1131=head2 clear_encoding
1132
1133Clears the encoding for the current context
1134
9c38cb50 1135=head2 encoding
1136
70005e98 1137Sets or gets the application encoding. Setting encoding takes either an
1138Encoding object or a string that we try to resolve via L<Encode::find_encoding>.
1139
1140You would expect to get the encoding object back if you attempt to set it. If
1141there is a failure you will get undef returned and an error message in the log.
9c38cb50 1142
1143=cut
1144
6adc45cf 1145sub has_encoding { shift->encoding ? 1:0 }
1146
1147sub clear_encoding {
1148 my $c = shift;
1149 if(blessed $c) {
1150 $c->encoding(undef);
1151 } else {
70005e98 1152 $c->log->error("You can't clear encoding on the application");
6adc45cf 1153 }
1154}
1155
9c38cb50 1156sub encoding {
1157 my $c = shift;
1158 my $encoding;
1159
1160 if ( scalar @_ ) {
70005e98 1161
1162 # Don't let one change this once we are too far into the response
1163 if(blessed $c && $c->res->finalized_headers) {
1164 Carp::croak("You may not change the encoding once the headers are finalized");
1165 return;
1166 }
1167
9c38cb50 1168 # Let it be set to undef
1169 if (my $wanted = shift) {
1170 $encoding = Encode::find_encoding($wanted)
1171 or Carp::croak( qq/Unknown encoding '$wanted'/ );
1172 binmode(STDERR, ':encoding(' . $encoding->name . ')');
1173 }
1174 else {
1175 binmode(STDERR);
1176 }
1177
1178 $encoding = ref $c
1179 ? $c->{encoding} = $encoding
1180 : $c->_encoding($encoding);
1181 } else {
1182 $encoding = ref $c && exists $c->{encoding}
1183 ? $c->{encoding}
1184 : $c->_encoding;
1185 }
1186
1187 return $encoding;
1188}
b4b01a8a 1189
1190=head2 $c->debug
1191
c74d3f0c 1192Returns 1 if debug mode is enabled, 0 otherwise.
b4b01a8a 1193
7e5c67f2 1194You can enable debug mode in several ways:
1195
1196=over
1197
62a6df80 1198=item By calling myapp_server.pl with the -d flag
1199
7e5c67f2 1200=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
1201
1202=item The -Debug option in your MyApp.pm
1203
8eae92ad 1204=item By declaring C<sub debug { 1 }> in your MyApp.pm.
7e5c67f2 1205
1206=back
c74d3f0c 1207
c8083f4e 1208The first three also set the log level to 'debug'.
1209
8eae92ad 1210Calling C<< $c->debug(1) >> has no effect.
e80e8542 1211
af3ff00e 1212=cut
1213
b4b01a8a 1214sub debug { 0 }
1215
1216=head2 $c->dispatcher
1217
2887a7f1 1218Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 1219
1220=head2 $c->engine
1221
2887a7f1 1222Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 1223
1224
f7b672ef 1225=head2 UTILITY METHODS
66e28e3f 1226
b5ecfcf0 1227=head2 $c->path_to(@path)
01033d73 1228
cc95842f 1229Merges C<@path> with C<< $c->config->{home} >> and returns a
4e392da6 1230L<Path::Class::Dir> object. Note you can usually use this object as
1231a filename, but sometimes you will have to explicitly stringify it
18a9655c 1232yourself by calling the C<< ->stringify >> method.
01033d73 1233
1234For example:
1235
1236 $c->path_to( 'db', 'sqlite.db' );
1237
1238=cut
1239
1240sub path_to {
1241 my ( $c, @path ) = @_;
a738ab68 1242 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 1243 if ( -d $path ) { return $path }
a738ab68 1244 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 1245}
1246
0ef52a96 1247sub plugin {
1248 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 1249
4e68badc 1250 # See block comment in t/unit_core_plugin.t
3bdf9e57 1251 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
4e68badc 1252
97b58e17 1253 $class->_register_plugin( $plugin, 1 );
0ef52a96 1254
1255 eval { $plugin->import };
1256 $class->mk_classdata($name);
1257 my $obj;
1258 eval { $obj = $plugin->new(@args) };
1259
1260 if ($@) {
1261 Catalyst::Exception->throw( message =>
1262 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1263 }
1264
1265 $class->$name($obj);
1266 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1267 if $class->debug;
1268}
1269
b5ecfcf0 1270=head2 MyApp->setup
fbcc39ad 1271
e7f1cf73 1272Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 1273model, view, and controller components. You may also specify an array
1274of plugins to load here, if you choose to not load them in the C<use
1275Catalyst> line.
fbcc39ad 1276
0ef52a96 1277 MyApp->setup;
1278 MyApp->setup( qw/-Debug/ );
fbcc39ad 1279
cf7ace24 1280B<Note:> You B<should not> wrap this method with method modifiers
1281or bad things will happen - wrap the C<setup_finalize> method instead.
1282
ac1cf8d4 1283B<Note:> You can create a custom setup stage that will execute when the
1284application is starting. Use this to customize setup.
1285
1286 MyApp->setup(-Custom=value);
1287
1288 sub setup_custom {
1289 my ($class, $value) = @_;
1290 }
1291
1292Can be handy if you want to hook into the setup phase.
1293
fbcc39ad 1294=cut
1295
1296sub setup {
0319a12c 1297 my ( $class, @arguments ) = @_;
c2f3cc1b 1298 croak('Running setup more than once')
1299 if ( $class->setup_finished );
5168a5fc 1300
fbcc39ad 1301 unless ( $class->isa('Catalyst') ) {
953b0e15 1302
fbcc39ad 1303 Catalyst::Exception->throw(
1304 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 1305 }
0319a12c 1306
fbcc39ad 1307 if ( $class->arguments ) {
1308 @arguments = ( @arguments, @{ $class->arguments } );
1309 }
1310
1311 # Process options
1312 my $flags = {};
1313
1314 foreach (@arguments) {
1315
1316 if (/^-Debug$/) {
1317 $flags->{log} =
1318 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1319 }
1320 elsif (/^-(\w+)=?(.*)$/) {
1321 $flags->{ lc $1 } = $2;
1322 }
1323 else {
1324 push @{ $flags->{plugins} }, $_;
1325 }
1326 }
1327
99f187d6 1328 $class->setup_home( delete $flags->{home} );
1329
5bb2a5b3 1330 $class->setup_log( delete $flags->{log} );
fbcc39ad 1331 $class->setup_plugins( delete $flags->{plugins} );
17176f15 1332
b87d834e 1333 $class->setup_data_handlers();
fbcc39ad 1334 $class->setup_dispatcher( delete $flags->{dispatcher} );
acbecf08 1335 if (my $engine = delete $flags->{engine}) {
0aafa77a 1336 $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
acbecf08 1337 }
1338 $class->setup_engine();
dc5f035e 1339 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1340
1341 for my $flag ( sort keys %{$flags} ) {
1342
1343 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1344 &$code( $class, delete $flags->{$flag} );
1345 }
1346 else {
1347 $class->log->warn(qq/Unknown flag "$flag"/);
1348 }
1349 }
1350
0eb4af72 1351 eval { require Catalyst::Devel; };
1352 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1353 $class->log->warn(<<"EOF");
4ff0d824 1354You are running an old script!
1355
34a83d89 1356 Please update by running (this will overwrite existing files):
1357 catalyst.pl -force -scripts $class
1358
1359 or (this will not overwrite existing files):
1360 catalyst.pl -scripts $class
1cf0345b 1361
4ff0d824 1362EOF
0eb4af72 1363 }
62a6df80 1364
b677b4c2 1365 # Call plugins setup, this is stupid and evil.
1366 # Also screws C3 badly on 5.10, hack to avoid.
1367 {
1368 no warnings qw/redefine/;
1369 local *setup = sub { };
1370 $class->setup unless $Catalyst::__AM_RESTARTING;
1371 }
1372
9c38cb50 1373 # If you are expecting configuration info as part of your setup, it needs
1374 # to get called here and below, since we need the above line to support
1375 # ConfigLoader based configs.
1376
1377 $class->setup_encoding();
ac34e337 1378 $class->setup_middleware();
1379
02352a28 1380 # Initialize our data structure
1381 $class->components( {} );
1382
1383 $class->setup_components;
1384
fbcc39ad 1385 if ( $class->debug ) {
6601f2ad 1386 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1387
1388 if (@plugins) {
39fc2ce1 1389 my $column_width = Catalyst::Utils::term_width() - 6;
1390 my $t = Text::SimpleTable->new($column_width);
8c113188 1391 $t->row($_) for @plugins;
1cf0345b 1392 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1393 }
1394
ba0b0de3 1395 my @middleware = map {
1396 ref $_ eq 'CODE' ?
1397 "Inline Coderef" :
ef5ad930 1398 (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
ba0b0de3 1399 || '') } $class->registered_middlewares;
10e39267 1400
1401 if (@middleware) {
1402 my $column_width = Catalyst::Utils::term_width() - 6;
1403 my $t = Text::SimpleTable->new($column_width);
1404 $t->row($_) for @middleware;
1405 $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1406 }
1407
ef5ad930 1408 my %dh = $class->registered_data_handlers;
1409 if (my @data_handlers = keys %dh) {
b87d834e 1410 my $column_width = Catalyst::Utils::term_width() - 6;
1411 my $t = Text::SimpleTable->new($column_width);
1412 $t->row($_) for @data_handlers;
1413 $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1414 }
1415
fbcc39ad 1416 my $dispatcher = $class->dispatcher;
1417 my $engine = $class->engine;
1418 my $home = $class->config->{home};
1419
01ce7075 1420 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1421 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1422
1423 $home
1424 ? ( -d $home )
1425 ? $class->log->debug(qq/Found home "$home"/)
1426 : $class->log->debug(qq/Home "$home" doesn't exist/)
1427 : $class->log->debug(q/Couldn't find home/);
fbcc39ad 1428
39fc2ce1 1429 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
8860df07 1430
39fc2ce1 1431 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1432 for my $comp ( sort keys %{ $class->components } ) {
1433 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1434 $t->row( $comp, $type );
1435 }
1cf0345b 1436 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1437 if ( keys %{ $class->components } );
fbcc39ad 1438 }
1439
1440 # Add our self to components, since we are also a component
96d8d513 1441 if( $class->isa('Catalyst::Controller') ){
1442 $class->components->{$class} = $class;
1443 }
fbcc39ad 1444
1445 $class->setup_actions;
1446
1447 if ( $class->debug ) {
1448 my $name = $class->config->{name} || 'Application';
1449 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1450 }
3643e890 1451
647a3de1 1452 if ($class->config->{case_sensitive}) {
1453 $class->log->warn($class . "->config->{case_sensitive} is set.");
1454 $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1455 }
1456
a5d07d29 1457 $class->setup_finalize;
1b526dcc 1458
1459 # Flush the log for good measure (in case something turned off 'autoflush' early)
647a3de1 1460 $class->log->_flush() if $class->log->can('_flush');
1b526dcc 1461
5077b8a3 1462 return $class || 1; # Just in case someone named their Application 0...
a5d07d29 1463}
1464
23c63a17 1465=head2 $app->setup_finalize
1466
128a7cee 1467A hook to attach modifiers to. This method does not do anything except set the
1468C<setup_finished> accessor.
23c63a17 1469
ae7da8f5 1470Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
23c63a17 1471
128a7cee 1472Example:
23c63a17 1473
128a7cee 1474 after setup_finalize => sub {
1475 my $app = shift;
23c63a17 1476
128a7cee 1477 ## do stuff here..
1478 };
23c63a17 1479
1480=cut
1481
a5d07d29 1482sub setup_finalize {
1483 my ($class) = @_;
3643e890 1484 $class->setup_finished(1);
fbcc39ad 1485}
1486
b4fed1aa 1487=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? )
fbcc39ad 1488
b4fed1aa 1489=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? )
9df7c5d9 1490
b4fed1aa 1491=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? )
b063a165 1492
ee8963de 1493Constructs an absolute L<URI> object based on the application root, the
1494provided path, and the additional arguments and query parameters provided.
186d5270 1495When used as a string, provides a textual URI. If you need more flexibility
92981fc3 1496than this (i.e. the option to provide relative URIs etc.) see
186d5270 1497L<Catalyst::Plugin::SmartURI>.
ee8963de 1498
d71da6fe 1499If no arguments are provided, the URI for the current action is returned.
1500To return the current action and also provide @args, use
1d3a0700 1501C<< $c->uri_for( $c->action, @args ) >>.
d71da6fe 1502
ee8963de 1503If the first argument is a string, it is taken as a public URI path relative
1504to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
e7e4c469 1505relative to the application root (if it does). It is then merged with
ee8963de 1506C<< $c->request->base >>; any C<@args> are appended as additional path
1507components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1508
1509If the first argument is a L<Catalyst::Action> it represents an action which
1510will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1511optional C<\@captures> argument (an arrayref) allows passing the captured
1512variables that are needed to fill in the paths of Chained and Regex actions;
1513once the path is resolved, C<uri_for> continues as though a path was
1514provided, appending any arguments or parameters and creating an absolute
1515URI.
1516
e7e4c469 1517The captures for the current request can be found in
ee8963de 1518C<< $c->request->captures >>, and actions can be resolved using
1519C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1520path, use C<< $c->uri_for_action >> instead.
1521
1522 # Equivalent to $c->req->uri
e7e4c469 1523 $c->uri_for($c->action, $c->req->captures,
ee8963de 1524 @{ $c->req->args }, $c->req->params);
62a6df80 1525
9df7c5d9 1526 # For the Foo action in the Bar controller
ee8963de 1527 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1528
ee8963de 1529 # Path to a static resource
1530 $c->uri_for('/static/images/logo.png');
d5e3d528 1531
342d2169 1532In general the scheme of the generated URI object will follow the incoming request
1533however if your targeted action or action chain has the Scheme attribute it will
1534use that instead.
1535
d2b583c3 1536Also, if the targeted Action or Action chain declares Args/CaptureArgs that have
1537type constraints, we will require that your proposed URL verify on those declared
1538constraints.
1539
4cf1dd00 1540=cut
1541
fbcc39ad 1542sub uri_for {
00e6a2b7 1543 my ( $c, $path, @args ) = @_;
00e6a2b7 1544
0ee04045 1545 if ( $path->$_isa('Catalyst::Controller') ) {
7069eab5 1546 $path = $path->path_prefix;
1547 $path =~ s{/+\z}{};
1548 $path .= '/';
1549 }
1550
2689f8a4 1551 undef($path) if (defined $path && $path eq '');
1552
6b9f9ef7 1553 my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
1554
2689f8a4 1555 my $params =
1556 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1557
1558 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
5c779e98 1559
342d2169 1560 my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
0ee04045 1561 if ( $path->$_isa('Catalyst::Action') ) { # action object
c042d18d 1562 s|/|%2F|g for @args;
2689f8a4 1563 my $captures = [ map { s|/|%2F|g; $_; }
c042d18d 1564 ( scalar @args && ref $args[0] eq 'ARRAY'
1565 ? @{ shift(@args) }
aaf72276 1566 : ()) ];
7b346bc3 1567
aa7e913e 1568 my $action = $path;
86a399db 1569 my $expanded_action = $c->dispatcher->expand_action( $action );
d2b583c3 1570 my $num_captures = $expanded_action->number_of_captures;
86a399db 1571
0cff119a 1572 # ->uri_for( $action, \@captures_and_args, \%query_values? )
c042d18d 1573 if( !@args && $action->number_of_args ) {
1574 unshift @args, splice @$captures, $num_captures;
0cff119a 1575 }
1576
86a399db 1577 if($num_captures) {
ec4d7259 1578 unless($expanded_action->match_captures_constraints($c, $captures)) {
1579 carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'";
86a399db 1580 return;
c1192f1e 1581 }
1582 }
1583
1584 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1585 if (not defined $path) {
1586 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1587 if $c->debug;
1588 return undef;
1589 }
81e75875 1590 $path = '/' if $path eq '';
c1192f1e 1591
1592 # At this point @encoded_args is the remaining Args (all captures removed).
86a399db 1593 if($expanded_action->has_args_constraints) {
c042d18d 1594 unless($expanded_action->match_args($c,\@args)) {
1595 carp "args [@args] do not match the type constraints in action '$expanded_action'";
86a399db 1596 return;
c1192f1e 1597 }
1598 }
ea0e58d9 1599 }
1600
c042d18d 1601 unshift(@args, $path);
51674a63 1602
1603 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1604 my $namespace = $c->namespace;
1605 if (defined $path) { # cheesy hack to handle path '../foo'
c042d18d 1606 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1607 }
c042d18d 1608 unshift(@args, $namespace || '');
51674a63 1609 }
62a6df80 1610
189e2a51 1611 # join args with '/', or a blank string
c042d18d 1612 my $args = join('/', grep { defined($_) } @args);
51674a63 1613 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1614 $args =~ s!^/+!!;
f9451270 1615
1616 my ($base, $class) = ('/', 'URI::_generic');
1617 if(blessed($c)) {
1618 $base = $c->req->base;
342d2169 1619 if($target_action) {
1620 $target_action = $c->dispatcher->expand_action($target_action);
1621 if(my $s = $target_action->scheme) {
1622 $s = lc($s);
1623 $class = "URI::$s";
1624 $base->scheme($s);
1625 } else {
1626 $class = ref($base);
1627 }
1628 } else {
1629 $class = ref($base);
1630 }
1631
f9451270 1632 $base =~ s{(?<!/)$}{/};
1633 }
51674a63 1634
1635 my $query = '';
51674a63 1636 if (my @keys = keys %$params) {
1637 # somewhat lifted from URI::_query's query_form
1638 $query = '?'.join('&', map {
2f381252 1639 my $val = $params->{$_};
5c779e98 1640 #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP
51674a63 1641 s/ /+/g;
1642 my $key = $_;
51674a63 1643 $val = '' unless defined $val;
1644 (map {
1f851263 1645 my $param = "$_";
fdbf03db 1646 $param = encode_utf8($param);
51674a63 1647 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1648 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1649 $param =~ s/ /+/g;
5c779e98 1650
fdbf03db 1651 $key = encode_utf8($key);
5c779e98 1652 # using the URI::Escape pattern here so utf8 chars survive
1653 $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1654 $key =~ s/ /+/g;
1655
1f851263 1656 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1657 } @keys);
1658 }
1659
d2b583c3 1660 $base = encode_utf8 $base;
1661 $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1662 $args = encode_utf8 $args;
1663 $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
3a6d7f15 1664
6b9f9ef7 1665 if(defined $fragment) {
1666 $fragment = encode_utf8(${$fragment});
1667 $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1668 $fragment =~ s/ /+/g;
1669 $query .= "#$fragment";
1670 }
3a6d7f15 1671
51674a63 1672 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1673 $res;
fbcc39ad 1674}
1675
25d61080 1676=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1677
25d61080 1678=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1679
1680=over
1681
1682=item $path
1683
1684A private path to the Catalyst action you want to create a URI for.
1685
1686This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1687>> and passing the resulting C<$action> and the remaining arguments to C<<
1688$c->uri_for >>.
1689
1690You can also pass in a Catalyst::Action object, in which case it is passed to
1691C<< $c->uri_for >>.
1692
c9ec25f8 1693Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action.
1694
1695For example, if the action looks like:
1696
1697 package MyApp::Controller::Users;
1698
1699 sub lst : Path('the-list') {}
1700
1701You can use:
1702
1703 $c->uri_for_action('/users/lst')
1704
1705and it will create the URI /users/the-list.
1706
25d61080 1707=item \@captures_and_args?
1708
1709Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1710and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1711to interpolate all the parameters in the URI.
1712
1713=item @args?
1714
942572d7 1715Optional list of extra arguments - can be supplied in the
1716C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1717code.
25d61080 1718
942572d7 1719Your action can have zero, a fixed or a variable number of args (e.g.
1720C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1721
1722=item \%query_values?
1723
1724Optional array reference of query parameters to append. E.g.
1725
1726 { foo => 'bar' }
1727
1728will generate
1729
1730 /rest/of/your/uri?foo=bar
1731
833b385e 1732=back
1733
1734=cut
1735
1736sub uri_for_action {
1737 my ( $c, $path, @args ) = @_;
62a6df80 1738 my $action = blessed($path)
1739 ? $path
833b385e 1740 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1741 unless (defined $action) {
1742 croak "Can't find action for path '$path'";
1743 }
833b385e 1744 return $c->uri_for( $action, @args );
1745}
1746
b5ecfcf0 1747=head2 $c->welcome_message
ab2374d3 1748
1749Returns the Catalyst welcome HTML page.
1750
1751=cut
1752
1753sub welcome_message {
bf1f2c60 1754 my $c = shift;
1755 my $name = $c->config->{name};
1756 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1757 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1758 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1759 return <<"EOF";
80cdbbff 1760<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1761 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1762<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1763 <head>
85d9fce6 1764 <meta http-equiv="Content-Language" content="en" />
1765 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1766 <title>$name on Catalyst $VERSION</title>
1767 <style type="text/css">
1768 body {
ab2374d3 1769 color: #000;
1770 background-color: #eee;
1771 }
1772 div#content {
1773 width: 640px;
80cdbbff 1774 margin-left: auto;
1775 margin-right: auto;
ab2374d3 1776 margin-top: 10px;
1777 margin-bottom: 10px;
1778 text-align: left;
1779 background-color: #ccc;
1780 border: 1px solid #aaa;
ab2374d3 1781 }
d84c4dab 1782 p, h1, h2 {
ab2374d3 1783 margin-left: 20px;
1784 margin-right: 20px;
16215972 1785 font-family: verdana, tahoma, sans-serif;
ab2374d3 1786 }
d84c4dab 1787 a {
1788 font-family: verdana, tahoma, sans-serif;
1789 }
d114e033 1790 :link, :visited {
1791 text-decoration: none;
1792 color: #b00;
1793 border-bottom: 1px dotted #bbb;
1794 }
1795 :link:hover, :visited:hover {
d114e033 1796 color: #555;
1797 }
ab2374d3 1798 div#topbar {
1799 margin: 0px;
1800 }
3e82a295 1801 pre {
3e82a295 1802 margin: 10px;
1803 padding: 8px;
1804 }
ab2374d3 1805 div#answers {
1806 padding: 8px;
1807 margin: 10px;
d114e033 1808 background-color: #fff;
ab2374d3 1809 border: 1px solid #aaa;
ab2374d3 1810 }
1811 h1 {
33108eaf 1812 font-size: 0.9em;
1813 font-weight: normal;
ab2374d3 1814 text-align: center;
1815 }
1816 h2 {
1817 font-size: 1.0em;
1818 }
1819 p {
1820 font-size: 0.9em;
1821 }
ae7c5252 1822 p img {
1823 float: right;
1824 margin-left: 10px;
1825 }
9619f23c 1826 span#appname {
1827 font-weight: bold;
33108eaf 1828 font-size: 1.6em;
ab2374d3 1829 }
1830 </style>
1831 </head>
1832 <body>
1833 <div id="content">
1834 <div id="topbar">
9619f23c 1835 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1836 $VERSION</h1>
ab2374d3 1837 </div>
1838 <div id="answers">
ae7c5252 1839 <p>
80cdbbff 1840 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1841 </p>
596aaffe 1842 <p>Welcome to the world of Catalyst.
f92fd545 1843 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1844 framework will make web development something you had
60dd6e1d 1845 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1846 <h2>What to do now?</h2>
4b8cb778 1847 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1848 We do, however, provide you with a few starting points.</p>
1849 <p>If you want to jump right into web development with Catalyst
2f381252 1850 you might want to start with a tutorial.</p>
80267996 1851<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1852</pre>
1853<p>Afterwards you can go on to check out a more complete look at our features.</p>
1854<pre>
80267996 1855<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1856<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1857</code></pre>
ab2374d3 1858 <h2>What to do next?</h2>
f5681c92 1859 <p>Next it's time to write an actual application. Use the
80267996 1860 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1861 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1862 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1863 they can save you a lot of work.</p>
c5f31918 1864 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1865 <p>Also, be sure to check out the vast and growing
802bf2cb 1866 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1867 you are likely to find what you need there.
f5681c92 1868 </p>
1869
82245cc4 1870 <h2>Need help?</h2>
f5681c92 1871 <p>Catalyst has a very active community. Here are the main places to
1872 get in touch with us.</p>
16215972 1873 <ul>
1874 <li>
2b9a7d76 1875 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1876 </li>
1877 <li>
6d4c3368 1878 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1879 </li>
1880 <li>
4eaf7c88 1881 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1882 </li>
1883 </ul>
ab2374d3 1884 <h2>In conclusion</h2>
62a6df80 1885 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1886 as we enjoyed making it. Please contact us if you have ideas
1887 for improvement or other feedback.</p>
ab2374d3 1888 </div>
1889 </div>
1890 </body>
1891</html>
1892EOF
1893}
1894
aee7cdcc 1895=head2 run_options
1896
1897Contains a hash of options passed from the application script, including
c2c8d3cb 1898the original ARGV the script received, the processed values from that
aee7cdcc 1899ARGV and any extra arguments to the script which were not processed.
1900
1901This can be used to add custom options to your application's scripts
1902and setup your application differently depending on the values of these
1903options.
1904
fbcc39ad 1905=head1 INTERNAL METHODS
1906
ae1e6b59 1907These methods are not meant to be used by end users.
1908
b5ecfcf0 1909=head2 $c->components
fbcc39ad 1910
e7f1cf73 1911Returns a hash of components.
fbcc39ad 1912
b5ecfcf0 1913=head2 $c->context_class
1f9cb7c1 1914
e7f1cf73 1915Returns or sets the context class.
1f9cb7c1 1916
b5ecfcf0 1917=head2 $c->counter
fbcc39ad 1918
ae1e6b59 1919Returns a hashref containing coderefs and execution counts (needed for
1920deep recursion detection).
fbcc39ad 1921
b5ecfcf0 1922=head2 $c->depth
fbcc39ad 1923
e7f1cf73 1924Returns the number of actions on the current internal execution stack.
fbcc39ad 1925
b5ecfcf0 1926=head2 $c->dispatch
fbcc39ad 1927
e7f1cf73 1928Dispatches a request to actions.
fbcc39ad 1929
1930=cut
1931
1932sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1933
b5ecfcf0 1934=head2 $c->dispatcher_class
1f9cb7c1 1935
e7f1cf73 1936Returns or sets the dispatcher class.
1f9cb7c1 1937
b5ecfcf0 1938=head2 $c->dump_these
7f92deef 1939
ae1e6b59 1940Returns a list of 2-element array references (name, structure) pairs
1941that will be dumped on the error page in debug mode.
7f92deef 1942
1943=cut
1944
1945sub dump_these {
1946 my $c = shift;
62a6df80 1947 [ Request => $c->req ],
1948 [ Response => $c->res ],
052a2d89 1949 [ Stash => $c->stash ],
1950 [ Config => $c->config ];
7f92deef 1951}
1952
b5ecfcf0 1953=head2 $c->engine_class
1f9cb7c1 1954
e7f1cf73 1955Returns or sets the engine class.
1f9cb7c1 1956
b5ecfcf0 1957=head2 $c->execute( $class, $coderef )
fbcc39ad 1958
0ef52a96 1959Execute a coderef in given class and catch exceptions. Errors are available
1960via $c->error.
fbcc39ad 1961
1962=cut
1963
1964sub execute {
1965 my ( $c, $class, $code ) = @_;
858828dd 1966 $class = $c->component($class) || $class;
fbcc39ad 1967 $c->state(0);
a0eca838 1968
197bd788 1969 if ( $c->depth >= $RECURSION ) {
f3414019 1970 my $action = $code->reverse();
91d08727 1971 $action = "/$action" unless $action =~ /->/;
f3414019 1972 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1973 $c->log->error($error);
1974 $c->error($error);
1975 $c->state(0);
1976 return $c->state;
1977 }
1978
dc5f035e 1979 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1980
8767c5a3 1981 push( @{ $c->stack }, $code );
62a6df80 1982
6f3df815 1983 no warnings 'recursion';
524b0e1c 1984 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1985 # I have no idea how, ergo $ret (which appears to fix the issue)
1986 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 1987
dc5f035e 1988 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1989
a6724a82 1990 my $last = pop( @{ $c->stack } );
fbcc39ad 1991
1992 if ( my $error = $@ ) {
e25e23a7 1993 #rethow if this can be handled by middleware
80172e7d 1994 if ( $c->_handle_http_exception($error) ) {
30e84ba1 1995 foreach my $err (@{$c->error}) {
1996 $c->log->error($err);
1997 }
1998 $c->clear_errors;
1999 $c->log->_flush if $c->log->can('_flush');
2000
e25e23a7 2001 $error->can('rethrow') ? $error->rethrow : croak $error;
2002 }
79f5d571 2003 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 2004 $error->rethrow if $c->depth > 1;
2f381252 2005 }
79f5d571 2006 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 2007 $error->rethrow if $c->depth > 0;
55424863 2008 }
fbcc39ad 2009 else {
2010 unless ( ref $error ) {
91d08727 2011 no warnings 'uninitialized';
fbcc39ad 2012 chomp $error;
f59def82 2013 my $class = $last->class;
2014 my $name = $last->name;
2015 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 2016 }
fbcc39ad 2017 $c->error($error);
fbcc39ad 2018 }
2688734f 2019 $c->state(0);
fbcc39ad 2020 }
2021 return $c->state;
2022}
2023
7a7d7af5 2024sub _stats_start_execute {
2025 my ( $c, $code ) = @_;
df960201 2026 my $appclass = ref($c) || $c;
a6724a82 2027 return if ( ( $code->name =~ /^_.*/ )
df960201 2028 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 2029
f3414019 2030 my $action_name = $code->reverse();
2031 $c->counter->{$action_name}++;
7a7d7af5 2032
f3414019 2033 my $action = $action_name;
a6724a82 2034 $action = "/$action" unless $action =~ /->/;
2035
7a7d7af5 2036 # determine if the call was the result of a forward
2037 # this is done by walking up the call stack and looking for a calling
2038 # sub of Catalyst::forward before the eval
2039 my $callsub = q{};
2040 for my $index ( 2 .. 11 ) {
2041 last
2042 if ( ( caller($index) )[0] eq 'Catalyst'
2043 && ( caller($index) )[3] eq '(eval)' );
2044
2045 if ( ( caller($index) )[3] =~ /forward$/ ) {
2046 $callsub = ( caller($index) )[3];
2047 $action = "-> $action";
2048 last;
2049 }
2050 }
2051
f3414019 2052 my $uid = $action_name . $c->counter->{$action_name};
74efc144 2053
a6724a82 2054 # is this a root-level call or a forwarded call?
2055 if ( $callsub =~ /forward$/ ) {
91740f34 2056 my $parent = $c->stack->[-1];
a6724a82 2057
2058 # forward, locate the caller
9c74923d 2059 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 2060 $c->stats->profile(
62a6df80 2061 begin => $action,
69d8f33c 2062 parent => "$parent" . $c->counter->{"$parent"},
2063 uid => $uid,
2064 );
7a7d7af5 2065 }
2066 else {
2067
a6724a82 2068 # forward with no caller may come from a plugin
69d8f33c 2069 $c->stats->profile(
2070 begin => $action,
2071 uid => $uid,
2072 );
7a7d7af5 2073 }
2074 }
a6724a82 2075 else {
62a6df80 2076
a6724a82 2077 # root-level call
69d8f33c 2078 $c->stats->profile(
2079 begin => $action,
2080 uid => $uid,
2081 );
a6724a82 2082 }
dc5f035e 2083 return $action;
7a7d7af5 2084
7a7d7af5 2085}
2086
2087sub _stats_finish_execute {
2088 my ( $c, $info ) = @_;
69d8f33c 2089 $c->stats->profile( end => $info );
7a7d7af5 2090}
2091
b5ecfcf0 2092=head2 $c->finalize
fbcc39ad 2093
e7f1cf73 2094Finalizes the request.
fbcc39ad 2095
2096=cut
2097
2098sub finalize {
2099 my $c = shift;
2100
369c09bc 2101 for my $error ( @{ $c->error } ) {
2102 $c->log->error($error);
2103 }
2104
eb1f4b49 2105 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
2106 # stuff like cometd and websockets
c4df830e 2107
c2fef52f 2108 if($c->request->_has_io_fh) {
74bebe95 2109 $c->log_response;
2110 return;
2111 }
eb1f4b49 2112
5050d7a7 2113 # Allow engine to handle finalize flow (for POE)
e63bdf38 2114 my $engine = $c->engine;
2115 if ( my $code = $engine->can('finalize') ) {
2116 $engine->$code($c);
fbcc39ad 2117 }
5050d7a7 2118 else {
fbcc39ad 2119
5050d7a7 2120 $c->finalize_uploads;
fbcc39ad 2121
5050d7a7 2122 # Error
2123 if ( $#{ $c->error } >= 0 ) {
2124 $c->finalize_error;
2125 }
2126
9c38cb50 2127 $c->finalize_encoding;
89ba65d5 2128 $c->finalize_headers unless $c->response->finalized_headers;
5050d7a7 2129 $c->finalize_body;
2130 }
62a6df80 2131
2bf54936 2132 $c->log_response;
10f204e1 2133
62a6df80 2134 if ($c->use_stats) {
87b41398 2135 my $elapsed = $c->stats->elapsed;
12bf12c0 2136 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 2137 $c->log->info(
62a6df80 2138 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 2139 }
fbcc39ad 2140
2141 return $c->response->status;
2142}
2143
b5ecfcf0 2144=head2 $c->finalize_body
fbcc39ad 2145
e7f1cf73 2146Finalizes body.
fbcc39ad 2147
2148=cut
2149
2150sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
2151
b5ecfcf0 2152=head2 $c->finalize_cookies
fbcc39ad 2153
e7f1cf73 2154Finalizes cookies.
fbcc39ad 2155
2156=cut
2157
147821ea 2158sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 2159
b5ecfcf0 2160=head2 $c->finalize_error
fbcc39ad 2161
df93c9b5 2162Finalizes error. If there is only one error in L</error> and it is an object that
2163does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
2164up the ladder. Otherwise we return the debugging error page (in debug mode) or we
2165return the default error page (production mode).
fbcc39ad 2166
2167=cut
2168
660f9bb0 2169sub finalize_error {
2170 my $c = shift;
2171 if($#{$c->error} > 0) {
2172 $c->engine->finalize_error( $c, @_ );
2173 } else {
2174 my ($error) = @{$c->error};
80172e7d 2175 if ( $c->_handle_http_exception($error) ) {
660f9bb0 2176 # In the case where the error 'knows what it wants', becauses its PSGI
2177 # aware, just rethow and let middleware catch it
2178 $error->can('rethrow') ? $error->rethrow : croak $error;
660f9bb0 2179 } else {
2180 $c->engine->finalize_error( $c, @_ )
2181 }
2182 }
2183}
fbcc39ad 2184
b5ecfcf0 2185=head2 $c->finalize_headers
fbcc39ad 2186
e7f1cf73 2187Finalizes headers.
fbcc39ad 2188
2189=cut
2190
2191sub finalize_headers {
2192 my $c = shift;
2193
e63bdf38 2194 my $response = $c->response; #accessor calls can add up?
2195
fbcc39ad 2196 # Check if we already finalized headers
6680c772 2197 return if $response->finalized_headers;
fbcc39ad 2198
2199 # Handle redirects
e63bdf38 2200 if ( my $location = $response->redirect ) {
fbcc39ad 2201 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 2202 $response->header( Location => $location );
fbcc39ad 2203 }
2204
9629478d 2205 # Remove incorrectly added body and content related meta data when returning
2206 # an information response, or a response the is required to not include a body
2207
fbcc39ad 2208 $c->finalize_cookies;
2209
6adc45cf 2210 # This currently is a NOOP but I don't want to remove it since I guess people
2211 # might have Response subclasses that use it for something... (JNAP)
89ba65d5 2212 $c->response->finalize_headers();
fbcc39ad 2213
2214 # Done
6680c772 2215 $response->finalized_headers(1);
fbcc39ad 2216}
2217
9c38cb50 2218=head2 $c->finalize_encoding
2219
4a64c27b 2220Make sure your body is encoded properly IF you set an encoding. By
566678d0 2221default the encoding is UTF-8 but you can disable it by explicitly setting the
dd096a3a 2222encoding configuration value to undef.
2223
6adc45cf 2224We can only encode when the body is a scalar. Methods for encoding via the
2225streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response>
2226are available).
2227
9c38cb50 2228See L</ENCODING>.
2229
2230=cut
2231
2232sub finalize_encoding {
2233 my $c = shift;
6adc45cf 2234 my $res = $c->res || return;
2235
2236 # Warn if the set charset is different from the one you put into encoding. We need
2237 # to do this early since encodable_response is false for this condition and we need
2238 # to match the debug output for backcompat (there's a test for this...) -JNAP
2239 if(
2240 $res->content_type_charset and $c->encoding and
2241 (uc($c->encoding->mime_name) ne uc($res->content_type_charset))
2242 ) {
2243 my $ct = lc($res->content_type_charset);
2244 $c->log->debug("Catalyst encoding config is set to encode in '" .
2245 $c->encoding->mime_name .
2246 "', content type is '$ct', not encoding ");
2247 }
9c38cb50 2248
6adc45cf 2249 if(
2250 ($res->encodable_response) and
2251 (defined($res->body)) and
2252 (ref(\$res->body) eq 'SCALAR')
2253 ) {
2254 $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
9c38cb50 2255
6adc45cf 2256 # Set the charset if necessary. This might be a bit bonkers since encodable response
2257 # is false when the set charset is not the same as the encoding mimetype (maybe
2258 # confusing action at a distance here..
9c056c82 2259 # Don't try to set the charset if one already exists or if headers are already finalized
6adc45cf 2260 $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
9c056c82 2261 unless($c->res->content_type_charset ||
2262 ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
9c38cb50 2263 }
9c38cb50 2264}
2265
b5ecfcf0 2266=head2 $c->finalize_output
fbcc39ad 2267
2268An alias for finalize_body.
2269
b5ecfcf0 2270=head2 $c->finalize_read
fbcc39ad 2271
e7f1cf73 2272Finalizes the input after reading is complete.
fbcc39ad 2273
2274=cut
2275
2276sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2277
b5ecfcf0 2278=head2 $c->finalize_uploads
fbcc39ad 2279
ae1e6b59 2280Finalizes uploads. Cleans up any temporary files.
fbcc39ad 2281
2282=cut
2283
2284sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2285
b5ecfcf0 2286=head2 $c->get_action( $action, $namespace )
fbcc39ad 2287
e7f1cf73 2288Gets an action in a given namespace.
fbcc39ad 2289
2290=cut
2291
684d10ed 2292sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2293
b5ecfcf0 2294=head2 $c->get_actions( $action, $namespace )
a9dc674c 2295
ae1e6b59 2296Gets all actions of a given name in a namespace and all parent
2297namespaces.
a9dc674c 2298
2299=cut
2300
2301sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2302
e5ce5f04 2303=head2 $app->handle_request( @arguments )
fbcc39ad 2304
e7f1cf73 2305Called to handle each HTTP request.
fbcc39ad 2306
2307=cut
2308
2309sub handle_request {
2310 my ( $class, @arguments ) = @_;
2311
2312 # Always expect worst case!
2313 my $status = -1;
3640641e 2314 try {
dea1884f 2315 if ($class->debug) {
908e3d9e 2316 my $secs = time - $START || 1;
2317 my $av = sprintf '%.3f', $COUNT / $secs;
2318 my $time = localtime time;
2319 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2320 }
908e3d9e 2321
2322 my $c = $class->prepare(@arguments);
2323 $c->dispatch;
62a6df80 2324 $status = $c->finalize;
660f9bb0 2325 } catch {
660f9bb0 2326 #rethow if this can be handled by middleware
80172e7d 2327 if ( $class->_handle_http_exception($_) ) {
6e94698d 2328 $_->can('rethrow') ? $_->rethrow : croak $_;
660f9bb0 2329 }
6e94698d 2330 chomp(my $error = $_);
2331 $class->log->error(qq/Caught exception in engine "$error"/);
3640641e 2332 };
fbcc39ad 2333
2334 $COUNT++;
62a6df80 2335
6680c772 2336 if(my $coderef = $class->log->can('_flush')){
2337 $class->log->$coderef();
2338 }
fbcc39ad 2339 return $status;
2340}
2341
d536010b 2342=head2 $class->prepare( @arguments )
fbcc39ad 2343
ae1e6b59 2344Creates a Catalyst context from an engine-specific request (Apache, CGI,
2345etc.).
fbcc39ad 2346
2347=cut
2348
398f13db 2349has _uploadtmp => (
2350 is => 'ro',
2351 predicate => '_has_uploadtmp',
2352);
2353
fbcc39ad 2354sub prepare {
2355 my ( $class, @arguments ) = @_;
2356
6680c772 2357 # XXX
2358 # After the app/ctxt split, this should become an attribute based on something passed
2359 # into the application.
3cec521a 2360 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2361
398f13db 2362 my $uploadtmp = $class->config->{uploadtmp};
2363 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2364
258733f1 2365 $c->response->_context($c);
2366
395037a2 2367 $c->stats($class->stats_class->new)->enable($c->use_stats);
ec4d7259 2368
4f0b7cf1 2369 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2370 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2371 }
2372
3640641e 2373 try {
2374 # Allow engine to direct the prepare flow (for POE)
2375 if ( my $prepare = $c->engine->can('prepare') ) {
2376 $c->engine->$prepare( $c, @arguments );
2377 }
2378 else {
2379 $c->prepare_request(@arguments);
2380 $c->prepare_connection;
2381 $c->prepare_query_parameters;
41aaa5d6 2382 $c->prepare_headers; # Just hooks, no longer needed - they just
2383 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2384 $c->prepare_path;
2385
2386 # Prepare the body for reading, either by prepare_body
2387 # or the user, if they are using $c->read
2388 $c->prepare_read;
2389
2390 # Parse the body unless the user wants it on-demand
2391 unless ( ref($c)->config->{parse_on_demand} ) {
2392 $c->prepare_body;
2393 }
878b821c 2394 }
676bed72 2395 $c->prepare_action;
5050d7a7 2396 }
3640641e 2397 # VERY ugly and probably shouldn't rely on ->finalize actually working
2398 catch {
2399 # failed prepare is always due to an invalid request, right?
2400 $c->response->status(400);
2401 $c->response->content_type('text/plain');
2402 $c->response->body('Bad Request');
5e25c01f 2403 # Note we call finalize and then die here, which escapes
2404 # finalize being called in the enclosing block..
2405 # It in fact couldn't be called, as we don't return $c..
2406 # This is a mess - but I'm unsure you can fix this without
2407 # breaking compat for people doing crazy things (we should set
2408 # the 400 and just return the ctx here IMO, letting finalize get called
2409 # above...
3640641e 2410 $c->finalize;
2411 die $_;
2412 };
fbcc39ad 2413
10f204e1 2414 $c->log_request;
fbcc39ad 2415
2416 return $c;
2417}
2418
b5ecfcf0 2419=head2 $c->prepare_action
fbcc39ad 2420
b4b01a8a 2421Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2422
2423=cut
2424
9c38cb50 2425sub prepare_action {
2426 my $c = shift;
2427 my $ret = $c->dispatcher->prepare_action( $c, @_);
2428
2429 if($c->encoding) {
2430 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2431 $_ = $c->_handle_param_unicode_decoding($_);
2432 }
2433 }
2434
2435 return $ret;
2436}
2437
fbcc39ad 2438
b5ecfcf0 2439=head2 $c->prepare_body
fbcc39ad 2440
e7f1cf73 2441Prepares message body.
fbcc39ad 2442
2443=cut
2444
2445sub prepare_body {
2446 my $c = shift;
2447
0f56bbcf 2448 return if $c->request->_has_body;
fbcc39ad 2449
2450 # Initialize on-demand data
2451 $c->engine->prepare_body( $c, @_ );
2452 $c->prepare_parameters;
2453 $c->prepare_uploads;
fbcc39ad 2454}
2455
b5ecfcf0 2456=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2457
e7f1cf73 2458Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2459
b4b01a8a 2460See L<Catalyst::Engine>.
2461
4bd82c41 2462=cut
2463
4f5ebacd 2464sub prepare_body_chunk {
2465 my $c = shift;
4bd82c41 2466 $c->engine->prepare_body_chunk( $c, @_ );
2467}
2468
b5ecfcf0 2469=head2 $c->prepare_body_parameters
fbcc39ad 2470
e7f1cf73 2471Prepares body parameters.
fbcc39ad 2472
2473=cut
2474
2475sub prepare_body_parameters {
2476 my $c = shift;
b9d96e27 2477 $c->request->prepare_body_parameters( $c, @_ );
fbcc39ad 2478}
2479
b5ecfcf0 2480=head2 $c->prepare_connection
fbcc39ad 2481
e7f1cf73 2482Prepares connection.
fbcc39ad 2483
2484=cut
2485
2486sub prepare_connection {
2487 my $c = shift;
817ed8ab 2488 $c->request->prepare_connection($c);
fbcc39ad 2489}
2490
b5ecfcf0 2491=head2 $c->prepare_cookies
fbcc39ad 2492
41aaa5d6 2493Prepares cookies by ensuring that the attribute on the request
2494object has been built.
fbcc39ad 2495
2496=cut
2497
41aaa5d6 2498sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2499
b5ecfcf0 2500=head2 $c->prepare_headers
fbcc39ad 2501
41aaa5d6 2502Prepares request headers by ensuring that the attribute on the request
2503object has been built.
fbcc39ad 2504
2505=cut
2506
41aaa5d6 2507sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2508
b5ecfcf0 2509=head2 $c->prepare_parameters
fbcc39ad 2510
e7f1cf73 2511Prepares parameters.
fbcc39ad 2512
2513=cut
2514
2515sub prepare_parameters {
2516 my $c = shift;
2517 $c->prepare_body_parameters;
2518 $c->engine->prepare_parameters( $c, @_ );
2519}
2520
b5ecfcf0 2521=head2 $c->prepare_path
fbcc39ad 2522
e7f1cf73 2523Prepares path and base.
fbcc39ad 2524
2525=cut
2526
2527sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2528
b5ecfcf0 2529=head2 $c->prepare_query_parameters
fbcc39ad 2530
e7f1cf73 2531Prepares query parameters.
fbcc39ad 2532
2533=cut
2534
2535sub prepare_query_parameters {
2536 my $c = shift;
2537
2538 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2539}
fbcc39ad 2540
10f204e1 2541=head2 $c->log_request
2542
2543Writes information about the request to the debug logs. This includes:
2544
2545=over 4
2546
854e5dcd 2547=item * Request method, path, and remote IP address
10f204e1 2548
2549=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2550
e7cbe1bf 2551=item * Request parameters
10f204e1 2552
2553=item * File uploads
2554
2555=back
fbcc39ad 2556
2557=cut
2558
10f204e1 2559sub log_request {
2560 my $c = shift;
fbcc39ad 2561
10f204e1 2562 return unless $c->debug;
fbcc39ad 2563
2bf54936 2564 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2565 my $request = $dump->[1];
e7cbe1bf 2566
2567 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2568 $method ||= '';
2569 $path = '/' unless length $path;
2570 $address ||= '';
0ca510f0 2571
2572 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
2573 $path = decode_utf8($path);
2574
10f204e1 2575 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2576
3a4abdb3 2577 $c->log_request_headers($request->headers);
e7cbe1bf 2578
2579 if ( my $keywords = $request->query_keywords ) {
10f204e1 2580 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2581 }
10f204e1 2582
9c74923d 2583 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2584
e7cbe1bf 2585 $c->log_request_uploads($request);
fbcc39ad 2586}
2587
10f204e1 2588=head2 $c->log_response
fbcc39ad 2589
75b65816 2590Writes information about the response to the debug logs by calling
2591C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2592
2593=cut
2594
75b65816 2595sub log_response {
2596 my $c = shift;
fbcc39ad 2597
75b65816 2598 return unless $c->debug;
fbcc39ad 2599
75b65816 2600 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2601 my $response = $dump->[1];
2602
2603 $c->log_response_status_line($response);
2604 $c->log_response_headers($response->headers);
2605}
2606
2607=head2 $c->log_response_status_line($response)
2608
2609Writes one line of information about the response to the debug logs. This includes:
10f204e1 2610
2611=over 4
2612
2613=item * Response status code
2614
3a4abdb3 2615=item * Content-Type header (if present)
2616
2617=item * Content-Length header (if present)
10f204e1 2618
2619=back
fbcc39ad 2620
2621=cut
2622
75b65816 2623sub log_response_status_line {
2624 my ($c, $response) = @_;
fbcc39ad 2625
697bab77 2626 $c->log->debug(
2627 sprintf(
2628 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2629 $response->status || 'unknown',
2630 $response->headers->header('Content-Type') || 'unknown',
2631 $response->headers->header('Content-Length') || 'unknown'
2632 )
2633 );
10f204e1 2634}
fbcc39ad 2635
75b65816 2636=head2 $c->log_response_headers($headers);
2637
8ad6fd58 2638Hook method which can be wrapped by plugins to log the response headers.
75b65816 2639No-op in the default implementation.
fbcc39ad 2640
2641=cut
2642
75b65816 2643sub log_response_headers {}
fbcc39ad 2644
10f204e1 2645=head2 $c->log_request_parameters( query => {}, body => {} )
2646
2647Logs request parameters to debug logs
2648
10f204e1 2649=cut
2650
2651sub log_request_parameters {
2652 my $c = shift;
2653 my %all_params = @_;
2654
2bf54936 2655 return unless $c->debug;
e7cbe1bf 2656
10f204e1 2657 my $column_width = Catalyst::Utils::term_width() - 44;
2658 foreach my $type (qw(query body)) {
2bf54936 2659 my $params = $all_params{$type};
2660 next if ! keys %$params;
10f204e1 2661 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2662 for my $key ( sort keys %$params ) {
2663 my $param = $params->{$key};
10f204e1 2664 my $value = defined($param) ? $param : '';
2665 $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2666 }
2667 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2668 }
2669}
2670
2671=head2 $c->log_request_uploads
2672
2673Logs file uploads included in the request to the debug logs.
854e5dcd 2674The parameter name, filename, file type, and file size are all included in
10f204e1 2675the debug logs.
2676
2677=cut
fbcc39ad 2678
10f204e1 2679sub log_request_uploads {
2680 my $c = shift;
2bf54936 2681 my $request = shift;
e7cbe1bf 2682 return unless $c->debug;
2683 my $uploads = $request->uploads;
10f204e1 2684 if ( keys %$uploads ) {
8c113188 2685 my $t = Text::SimpleTable->new(
34d28dfd 2686 [ 12, 'Parameter' ],
2687 [ 26, 'Filename' ],
8c113188 2688 [ 18, 'Type' ],
2689 [ 9, 'Size' ]
2690 );
10f204e1 2691 for my $key ( sort keys %$uploads ) {
2692 my $upload = $uploads->{$key};
fbcc39ad 2693 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2694 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2695 }
2696 }
2697 $c->log->debug( "File Uploads are:\n" . $t->draw );
2698 }
2699}
2700
3a4abdb3 2701=head2 $c->log_request_headers($headers);
2702
2703Hook method which can be wrapped by plugins to log the request headers.
2704No-op in the default implementation.
2705
2706=cut
2707
2708sub log_request_headers {}
2709
10f204e1 2710=head2 $c->log_headers($type => $headers)
2711
e7cbe1bf 2712Logs L<HTTP::Headers> (either request or response) to the debug logs.
10f204e1 2713
2714=cut
2715
2716sub log_headers {
2717 my $c = shift;
2718 my $type = shift;
2719 my $headers = shift; # an HTTP::Headers instance
2720
e7cbe1bf 2721 return unless $c->debug;
10f204e1 2722
f0e9921a 2723 my $column_width = Catalyst::Utils::term_width() - 28;
2724 my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
e7cbe1bf 2725 $headers->scan(
10f204e1 2726 sub {
2727 my ( $name, $value ) = @_;
2728 $t->row( $name, $value );
2729 }
2730 );
2731 $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2732}
2733
10f204e1 2734
2735=head2 $c->prepare_read
2736
2737Prepares the input for reading.
2738
2739=cut
2740
2741sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2742
2743=head2 $c->prepare_request
2744
2745Prepares the engine request.
2746
2747=cut
2748
2749sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2750
2751=head2 $c->prepare_uploads
2752
2753Prepares uploads.
2754
2755=cut
2756
2757sub prepare_uploads {
2758 my $c = shift;
10f204e1 2759 $c->engine->prepare_uploads( $c, @_ );
2760}
2761
b5ecfcf0 2762=head2 $c->prepare_write
fbcc39ad 2763
e7f1cf73 2764Prepares the output for writing.<