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