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