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