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