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