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