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