prep for release
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
38e43e65 7use namespace::clean -except => 'meta';
a2f2cde9 8use Catalyst::Exception;
154ef0c8 9use Catalyst::Exception::Detach;
10use Catalyst::Exception::Go;
fc7ec1d9 11use Catalyst::Log;
fbcc39ad 12use Catalyst::Request;
13use Catalyst::Request::Upload;
14use Catalyst::Response;
812a28c9 15use Catalyst::Utils;
31375184 16use Catalyst::Controller;
62b6b631 17use Data::OptList;
364d7324 18use Devel::InnerPackage ();
c50f595c 19use Module::Pluggable::Object ();
c50f595c 20use Text::SimpleTable ();
21use Path::Class::Dir ();
22use Path::Class::File ();
c50f595c 23use URI ();
933ba403 24use URI::http;
25use URI::https;
7af54927 26use HTML::Entities;
5513038d 27use Tree::Simple qw/use_weak_refs/;
28use Tree::Simple::Visitor::FindByUID;
269408a4 29use Class::C3::Adopt::NEXT;
196f06d1 30use List::MoreUtils qw/uniq/;
261c571e 31use attributes;
532f0516 32use String::RewritePrefix;
b1ededd4 33use Catalyst::EngineLoader;
5789a3d8 34use utf8;
108201b5 35use Carp qw/croak carp shortmess/;
3640641e 36use Try::Tiny;
4995a5ce 37use Safe::Isa;
dd5b1dc4 38use Moose::Util 'find_meta';
ad79be34 39use Plack::Middleware::Conditional;
40use Plack::Middleware::ReverseProxy;
fb99321f 41use Plack::Middleware::IIS6ScriptNameFix;
201e0a1f 42use Plack::Middleware::IIS7KeepAliveFix;
d3670826 43use Plack::Middleware::LighttpdScriptNameFix;
aa20e9f5 44use Plack::Middleware::ContentLength;
45use Plack::Middleware::Head;
660f9bb0 46use Plack::Middleware::HTTPExceptions;
ecf903d0 47use Plack::Middleware::FixMissingBodyInRedirect;
3157d22a 48use Plack::Middleware::MethodOverride;
79070bc6 49use Plack::Middleware::RemoveRedundantBody;
6561feae 50use Catalyst::Middleware::Stash;
20a09634 51use Plack::Util;
e7399d8b 52use Class::Load 'load_class';
0ca510f0 53use Encode 2.21 'decode_utf8', 'encode_utf8';
fc7ec1d9 54
0f6be50c 55BEGIN { require 5.008003; }
f63c03e4 56
8a440eba 57has stack => (is => 'ro', default => sub { [] });
6680c772 58has state => (is => 'rw', default => 0);
b6d4ee6e 59has stats => (is => 'rw');
60has action => (is => 'rw');
6680c772 61has counter => (is => 'rw', default => sub { {} });
398f13db 62has request => (
63 is => 'rw',
64 default => sub {
65 my $self = shift;
ec4d7259 66 my $class = ref $self;
67 my $composed_request_class = $class->composed_request_class;
68 return $composed_request_class->new( $self->_build_request_constructor_args);
398f13db 69 },
70 lazy => 1,
71);
a2c6c7b9 72sub _build_request_constructor_args {
0df490ef 73 my $self = shift;
74 my %p = ( _log => $self->log );
75 $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
b87d834e 76 $p{data_handlers} = {$self->registered_data_handlers};
88ba7793 77 $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
78 if $self->config->{use_hash_multivalue_in_request};
0df490ef 79 \%p;
80}
81
ec4d7259 82sub composed_request_class {
83 my $class = shift;
044e7667 84 my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]});
7dac038c 85
86 # For each trait listed, figure out what the namespace is. First we try the $trait
87 # as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try
88 # Catalyst::TraitFor::Request::$trait. If none load, throw error.
89
90 my $trait_ns = 'TraitFor::Request';
91 my @normalized_traits = map {
92 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
93 } @traits;
94
ec4d7259 95 return $class->_composed_request_class ||
7dac038c 96 $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits));
ec4d7259 97}
98
7c1c4dc6 99has response => (
100 is => 'rw',
101 default => sub {
102 my $self = shift;
ec4d7259 103 my $class = ref $self;
104 my $composed_response_class = $class->composed_response_class;
105 return $composed_response_class->new( $self->_build_response_constructor_args);
7c1c4dc6 106 },
107 lazy => 1,
108);
a2c6c7b9 109sub _build_response_constructor_args {
e8361cf8 110 return +{
111 _log => $_[0]->log,
112 encoding => $_[0]->encoding,
113 };
0df490ef 114}
115
ec4d7259 116sub composed_response_class {
117 my $class = shift;
044e7667 118 my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]});
7dac038c 119
120 my $trait_ns = 'TraitFor::Response';
121 my @normalized_traits = map {
122 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
123 } @traits;
124
ec4d7259 125 return $class->_composed_response_class ||
7dac038c 126 $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits));
ec4d7259 127}
128
e63bdf38 129has namespace => (is => 'rw');
130
8767c5a3 131sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 132sub comp { shift->component(@_) }
6680c772 133
134sub req {
6680c772 135 my $self = shift; return $self->request(@_);
136}
137sub res {
6680c772 138 my $self = shift; return $self->response(@_);
139}
fbcc39ad 140
141# For backwards compatibility
0fc2d522 142sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 143
144# For statistics
145our $COUNT = 1;
146our $START = time;
147our $RECURSION = 1000;
154ef0c8 148our $DETACH = Catalyst::Exception::Detach->new;
149our $GO = Catalyst::Exception::Go->new;
fbcc39ad 150
7dac038c 151#I imagine that very few of these really
152#need to be class variables. if any.
b6d4ee6e 153#maybe we should just make them attributes with a default?
fbcc39ad 154__PACKAGE__->mk_classdata($_)
3cec521a 155 for qw/components arguments dispatcher engine log dispatcher_class
1e5dad00 156 engine_loader context_class request_class response_class stats_class
b87d834e 157 setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
ec4d7259 158 _data_handlers _encoding _encode_check finalized_default_middleware
159 request_class_traits response_class_traits stats_class_traits
160 _composed_request_class _composed_response_class _composed_stats_class/;
cb0354c6 161
3cec521a 162__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
3cec521a 163__PACKAGE__->request_class('Catalyst::Request');
164__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 165__PACKAGE__->stats_class('Catalyst::Stats');
ec4d7259 166
167sub composed_stats_class {
168 my $class = shift;
044e7667 169 my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]});
7dac038c 170
171 my $trait_ns = 'TraitFor::Stats';
172 my @normalized_traits = map {
173 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
174 } @traits;
175
ec4d7259 176 return $class->_composed_stats_class ||
7dac038c 177 $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits));
ec4d7259 178}
179
9c38cb50 180__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
fbcc39ad 181
6415bb4d 182# Remember to update this in Catalyst::Runtime as well!
ed5a562b 183our $VERSION = '5.90096';
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
d71da6fe 1487=head2 $c->uri_for( $path?, @args?, \%query_values? )
fbcc39ad 1488
ee8963de 1489=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
9df7c5d9 1490
b063a165 1491=head2 $c->uri_for( $action, [@captures, @args], \%query_values? )
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
1509If the first argument is a L<Catalyst::Action> it represents an action which
1510will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1511optional C<\@captures> argument (an arrayref) allows passing the captured
1512variables that are needed to fill in the paths of Chained and Regex actions;
1513once the path is resolved, C<uri_for> continues as though a path was
1514provided, appending any arguments or parameters and creating an absolute
1515URI.
1516
e7e4c469 1517The captures for the current request can be found in
ee8963de 1518C<< $c->request->captures >>, and actions can be resolved using
1519C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1520path, use C<< $c->uri_for_action >> instead.
1521
1522 # Equivalent to $c->req->uri
e7e4c469 1523 $c->uri_for($c->action, $c->req->captures,
ee8963de 1524 @{ $c->req->args }, $c->req->params);
62a6df80 1525
9df7c5d9 1526 # For the Foo action in the Bar controller
ee8963de 1527 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1528
ee8963de 1529 # Path to a static resource
1530 $c->uri_for('/static/images/logo.png');
d5e3d528 1531
342d2169 1532In general the scheme of the generated URI object will follow the incoming request
1533however if your targeted action or action chain has the Scheme attribute it will
1534use that instead.
1535
d2b583c3 1536Also, if the targeted Action or Action chain declares Args/CaptureArgs that have
1537type constraints, we will require that your proposed URL verify on those declared
1538constraints.
1539
4cf1dd00 1540=cut
1541
fbcc39ad 1542sub uri_for {
00e6a2b7 1543 my ( $c, $path, @args ) = @_;
00e6a2b7 1544
0ee04045 1545 if ( $path->$_isa('Catalyst::Controller') ) {
7069eab5 1546 $path = $path->path_prefix;
1547 $path =~ s{/+\z}{};
1548 $path .= '/';
1549 }
1550
2689f8a4 1551 undef($path) if (defined $path && $path eq '');
1552
1553 my $params =
1554 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1555
1556 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
5c779e98 1557
342d2169 1558 my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
0ee04045 1559 if ( $path->$_isa('Catalyst::Action') ) { # action object
c042d18d 1560 s|/|%2F|g for @args;
2689f8a4 1561 my $captures = [ map { s|/|%2F|g; $_; }
c042d18d 1562 ( scalar @args && ref $args[0] eq 'ARRAY'
1563 ? @{ shift(@args) }
aaf72276 1564 : ()) ];
7b346bc3 1565
aa7e913e 1566 my $action = $path;
86a399db 1567 my $expanded_action = $c->dispatcher->expand_action( $action );
d2b583c3 1568 my $num_captures = $expanded_action->number_of_captures;
86a399db 1569
0cff119a 1570 # ->uri_for( $action, \@captures_and_args, \%query_values? )
c042d18d 1571 if( !@args && $action->number_of_args ) {
1572 unshift @args, splice @$captures, $num_captures;
0cff119a 1573 }
1574
86a399db 1575 if($num_captures) {
ec4d7259 1576 unless($expanded_action->match_captures_constraints($c, $captures)) {
1577 carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'";
86a399db 1578 return;
c1192f1e 1579 }
1580 }
1581
1582 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1583 if (not defined $path) {
1584 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1585 if $c->debug;
1586 return undef;
1587 }
81e75875 1588 $path = '/' if $path eq '';
c1192f1e 1589
1590 # At this point @encoded_args is the remaining Args (all captures removed).
86a399db 1591 if($expanded_action->has_args_constraints) {
c042d18d 1592 unless($expanded_action->match_args($c,\@args)) {
1593 carp "args [@args] do not match the type constraints in action '$expanded_action'";
86a399db 1594 return;
c1192f1e 1595 }
1596 }
ea0e58d9 1597 }
1598
c042d18d 1599 unshift(@args, $path);
51674a63 1600
1601 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1602 my $namespace = $c->namespace;
1603 if (defined $path) { # cheesy hack to handle path '../foo'
c042d18d 1604 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1605 }
c042d18d 1606 unshift(@args, $namespace || '');
51674a63 1607 }
62a6df80 1608
189e2a51 1609 # join args with '/', or a blank string
c042d18d 1610 my $args = join('/', grep { defined($_) } @args);
51674a63 1611 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1612 $args =~ s!^/+!!;
f9451270 1613
1614 my ($base, $class) = ('/', 'URI::_generic');
1615 if(blessed($c)) {
1616 $base = $c->req->base;
342d2169 1617 if($target_action) {
1618 $target_action = $c->dispatcher->expand_action($target_action);
1619 if(my $s = $target_action->scheme) {
1620 $s = lc($s);
1621 $class = "URI::$s";
1622 $base->scheme($s);
1623 } else {
1624 $class = ref($base);
1625 }
1626 } else {
1627 $class = ref($base);
1628 }
1629
f9451270 1630 $base =~ s{(?<!/)$}{/};
1631 }
51674a63 1632
1633 my $query = '';
1634
3a6d7f15 1635 # remove and save fragment if there is one
1636 my $fragment;
58b80ff1 1637 if ($args =~ s/#(.+)$//) {
1638 $fragment = encode_utf8($1);
1639 $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1640 $fragment =~ s/ /+/g;
3a6d7f15 1641 }
1642
51674a63 1643 if (my @keys = keys %$params) {
1644 # somewhat lifted from URI::_query's query_form
1645 $query = '?'.join('&', map {
2f381252 1646 my $val = $params->{$_};
5c779e98 1647 #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP
51674a63 1648 s/ /+/g;
1649 my $key = $_;
51674a63 1650 $val = '' unless defined $val;
1651 (map {
1f851263 1652 my $param = "$_";
fdbf03db 1653 $param = encode_utf8($param);
51674a63 1654 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1655 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1656 $param =~ s/ /+/g;
5c779e98 1657
fdbf03db 1658 $key = encode_utf8($key);
5c779e98 1659 # using the URI::Escape pattern here so utf8 chars survive
1660 $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1661 $key =~ s/ /+/g;
1662
1f851263 1663 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1664 } @keys);
1665 }
1666
d2b583c3 1667 $base = encode_utf8 $base;
1668 $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1669 $args = encode_utf8 $args;
1670 $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
3a6d7f15 1671
1672 # re-attach fragment on the end of everything after adding params
9d1f9508 1673 $query .= "#$fragment" if $fragment;
3a6d7f15 1674
51674a63 1675 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1676 $res;
fbcc39ad 1677}
1678
25d61080 1679=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1680
25d61080 1681=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1682
1683=over
1684
1685=item $path
1686
1687A private path to the Catalyst action you want to create a URI for.
1688
1689This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1690>> and passing the resulting C<$action> and the remaining arguments to C<<
1691$c->uri_for >>.
1692
1693You can also pass in a Catalyst::Action object, in which case it is passed to
1694C<< $c->uri_for >>.
1695
c9ec25f8 1696Note 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.
1697
1698For example, if the action looks like:
1699
1700 package MyApp::Controller::Users;
1701
1702 sub lst : Path('the-list') {}
1703
1704You can use:
1705
1706 $c->uri_for_action('/users/lst')
1707
1708and it will create the URI /users/the-list.
1709
25d61080 1710=item \@captures_and_args?
1711
1712Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1713and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1714to interpolate all the parameters in the URI.
1715
1716=item @args?
1717
942572d7 1718Optional list of extra arguments - can be supplied in the
1719C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1720code.
25d61080 1721
942572d7 1722Your action can have zero, a fixed or a variable number of args (e.g.
1723C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1724
1725=item \%query_values?
1726
1727Optional array reference of query parameters to append. E.g.
1728
1729 { foo => 'bar' }
1730
1731will generate
1732
1733 /rest/of/your/uri?foo=bar
1734
833b385e 1735=back
1736
1737=cut
1738
1739sub uri_for_action {
1740 my ( $c, $path, @args ) = @_;
62a6df80 1741 my $action = blessed($path)
1742 ? $path
833b385e 1743 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1744 unless (defined $action) {
1745 croak "Can't find action for path '$path'";
1746 }
833b385e 1747 return $c->uri_for( $action, @args );
1748}
1749
b5ecfcf0 1750=head2 $c->welcome_message
ab2374d3 1751
1752Returns the Catalyst welcome HTML page.
1753
1754=cut
1755
1756sub welcome_message {
bf1f2c60 1757 my $c = shift;
1758 my $name = $c->config->{name};
1759 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1760 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1761 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1762 return <<"EOF";
80cdbbff 1763<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1764 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1765<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1766 <head>
85d9fce6 1767 <meta http-equiv="Content-Language" content="en" />
1768 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1769 <title>$name on Catalyst $VERSION</title>
1770 <style type="text/css">
1771 body {
ab2374d3 1772 color: #000;
1773 background-color: #eee;
1774 }
1775 div#content {
1776 width: 640px;
80cdbbff 1777 margin-left: auto;
1778 margin-right: auto;
ab2374d3 1779 margin-top: 10px;
1780 margin-bottom: 10px;
1781 text-align: left;
1782 background-color: #ccc;
1783 border: 1px solid #aaa;
ab2374d3 1784 }
d84c4dab 1785 p, h1, h2 {
ab2374d3 1786 margin-left: 20px;
1787 margin-right: 20px;
16215972 1788 font-family: verdana, tahoma, sans-serif;
ab2374d3 1789 }
d84c4dab 1790 a {
1791 font-family: verdana, tahoma, sans-serif;
1792 }
d114e033 1793 :link, :visited {
1794 text-decoration: none;
1795 color: #b00;
1796 border-bottom: 1px dotted #bbb;
1797 }
1798 :link:hover, :visited:hover {
d114e033 1799 color: #555;
1800 }
ab2374d3 1801 div#topbar {
1802 margin: 0px;
1803 }
3e82a295 1804 pre {
3e82a295 1805 margin: 10px;
1806 padding: 8px;
1807 }
ab2374d3 1808 div#answers {
1809 padding: 8px;
1810 margin: 10px;
d114e033 1811 background-color: #fff;
ab2374d3 1812 border: 1px solid #aaa;
ab2374d3 1813 }
1814 h1 {
33108eaf 1815 font-size: 0.9em;
1816 font-weight: normal;
ab2374d3 1817 text-align: center;
1818 }
1819 h2 {
1820 font-size: 1.0em;
1821 }
1822 p {
1823 font-size: 0.9em;
1824 }
ae7c5252 1825 p img {
1826 float: right;
1827 margin-left: 10px;
1828 }
9619f23c 1829 span#appname {
1830 font-weight: bold;
33108eaf 1831 font-size: 1.6em;
ab2374d3 1832 }
1833 </style>
1834 </head>
1835 <body>
1836 <div id="content">
1837 <div id="topbar">
9619f23c 1838 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1839 $VERSION</h1>
ab2374d3 1840 </div>
1841 <div id="answers">
ae7c5252 1842 <p>
80cdbbff 1843 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1844 </p>
596aaffe 1845 <p>Welcome to the world of Catalyst.
f92fd545 1846 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1847 framework will make web development something you had
60dd6e1d 1848 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1849 <h2>What to do now?</h2>
4b8cb778 1850 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1851 We do, however, provide you with a few starting points.</p>
1852 <p>If you want to jump right into web development with Catalyst
2f381252 1853 you might want to start with a tutorial.</p>
80267996 1854<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1855</pre>
1856<p>Afterwards you can go on to check out a more complete look at our features.</p>
1857<pre>
80267996 1858<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1859<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1860</code></pre>
ab2374d3 1861 <h2>What to do next?</h2>
f5681c92 1862 <p>Next it's time to write an actual application. Use the
80267996 1863 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1864 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1865 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1866 they can save you a lot of work.</p>
c5f31918 1867 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1868 <p>Also, be sure to check out the vast and growing
802bf2cb 1869 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1870 you are likely to find what you need there.
f5681c92 1871 </p>
1872
82245cc4 1873 <h2>Need help?</h2>
f5681c92 1874 <p>Catalyst has a very active community. Here are the main places to
1875 get in touch with us.</p>
16215972 1876 <ul>
1877 <li>
2b9a7d76 1878 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1879 </li>
1880 <li>
6d4c3368 1881 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1882 </li>
1883 <li>
4eaf7c88 1884 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1885 </li>
1886 </ul>
ab2374d3 1887 <h2>In conclusion</h2>
62a6df80 1888 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1889 as we enjoyed making it. Please contact us if you have ideas
1890 for improvement or other feedback.</p>
ab2374d3 1891 </div>
1892 </div>
1893 </body>
1894</html>
1895EOF
1896}
1897
aee7cdcc 1898=head2 run_options
1899
1900Contains a hash of options passed from the application script, including
c2c8d3cb 1901the original ARGV the script received, the processed values from that
aee7cdcc 1902ARGV and any extra arguments to the script which were not processed.
1903
1904This can be used to add custom options to your application's scripts
1905and setup your application differently depending on the values of these
1906options.
1907
fbcc39ad 1908=head1 INTERNAL METHODS
1909
ae1e6b59 1910These methods are not meant to be used by end users.
1911
b5ecfcf0 1912=head2 $c->components
fbcc39ad 1913
e7f1cf73 1914Returns a hash of components.
fbcc39ad 1915
b5ecfcf0 1916=head2 $c->context_class
1f9cb7c1 1917
e7f1cf73 1918Returns or sets the context class.
1f9cb7c1 1919
b5ecfcf0 1920=head2 $c->counter
fbcc39ad 1921
ae1e6b59 1922Returns a hashref containing coderefs and execution counts (needed for
1923deep recursion detection).
fbcc39ad 1924
b5ecfcf0 1925=head2 $c->depth
fbcc39ad 1926
e7f1cf73 1927Returns the number of actions on the current internal execution stack.
fbcc39ad 1928
b5ecfcf0 1929=head2 $c->dispatch
fbcc39ad 1930
e7f1cf73 1931Dispatches a request to actions.
fbcc39ad 1932
1933=cut
1934
1935sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1936
b5ecfcf0 1937=head2 $c->dispatcher_class
1f9cb7c1 1938
e7f1cf73 1939Returns or sets the dispatcher class.
1f9cb7c1 1940
b5ecfcf0 1941=head2 $c->dump_these
7f92deef 1942
ae1e6b59 1943Returns a list of 2-element array references (name, structure) pairs
1944that will be dumped on the error page in debug mode.
7f92deef 1945
1946=cut
1947
1948sub dump_these {
1949 my $c = shift;
62a6df80 1950 [ Request => $c->req ],
1951 [ Response => $c->res ],
052a2d89 1952 [ Stash => $c->stash ],
1953 [ Config => $c->config ];
7f92deef 1954}
1955
b5ecfcf0 1956=head2 $c->engine_class
1f9cb7c1 1957
e7f1cf73 1958Returns or sets the engine class.
1f9cb7c1 1959
b5ecfcf0 1960=head2 $c->execute( $class, $coderef )
fbcc39ad 1961
0ef52a96 1962Execute a coderef in given class and catch exceptions. Errors are available
1963via $c->error.
fbcc39ad 1964
1965=cut
1966
1967sub execute {
1968 my ( $c, $class, $code ) = @_;
858828dd 1969 $class = $c->component($class) || $class;
fbcc39ad 1970 $c->state(0);
a0eca838 1971
197bd788 1972 if ( $c->depth >= $RECURSION ) {
f3414019 1973 my $action = $code->reverse();
91d08727 1974 $action = "/$action" unless $action =~ /->/;
f3414019 1975 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1976 $c->log->error($error);
1977 $c->error($error);
1978 $c->state(0);
1979 return $c->state;
1980 }
1981
dc5f035e 1982 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1983
8767c5a3 1984 push( @{ $c->stack }, $code );
62a6df80 1985
6f3df815 1986 no warnings 'recursion';
524b0e1c 1987 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1988 # I have no idea how, ergo $ret (which appears to fix the issue)
1989 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 1990
dc5f035e 1991 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1992
a6724a82 1993 my $last = pop( @{ $c->stack } );
fbcc39ad 1994
1995 if ( my $error = $@ ) {
e25e23a7 1996 #rethow if this can be handled by middleware
80172e7d 1997 if ( $c->_handle_http_exception($error) ) {
30e84ba1 1998 foreach my $err (@{$c->error}) {
1999 $c->log->error($err);
2000 }
2001 $c->clear_errors;
2002 $c->log->_flush if $c->log->can('_flush');
2003
e25e23a7 2004 $error->can('rethrow') ? $error->rethrow : croak $error;
2005 }
79f5d571 2006 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 2007 $error->rethrow if $c->depth > 1;
2f381252 2008 }
79f5d571 2009 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 2010 $error->rethrow if $c->depth > 0;
55424863 2011 }
fbcc39ad 2012 else {
2013 unless ( ref $error ) {
91d08727 2014 no warnings 'uninitialized';
fbcc39ad 2015 chomp $error;
f59def82 2016 my $class = $last->class;
2017 my $name = $last->name;
2018 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 2019 }
fbcc39ad 2020 $c->error($error);
fbcc39ad 2021 }
2688734f 2022 $c->state(0);
fbcc39ad 2023 }
2024 return $c->state;
2025}
2026
7a7d7af5 2027sub _stats_start_execute {
2028 my ( $c, $code ) = @_;
df960201 2029 my $appclass = ref($c) || $c;
a6724a82 2030 return if ( ( $code->name =~ /^_.*/ )
df960201 2031 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 2032
f3414019 2033 my $action_name = $code->reverse();
2034 $c->counter->{$action_name}++;
7a7d7af5 2035
f3414019 2036 my $action = $action_name;
a6724a82 2037 $action = "/$action" unless $action =~ /->/;
2038
7a7d7af5 2039 # determine if the call was the result of a forward
2040 # this is done by walking up the call stack and looking for a calling
2041 # sub of Catalyst::forward before the eval
2042 my $callsub = q{};
2043 for my $index ( 2 .. 11 ) {
2044 last
2045 if ( ( caller($index) )[0] eq 'Catalyst'
2046 && ( caller($index) )[3] eq '(eval)' );
2047
2048 if ( ( caller($index) )[3] =~ /forward$/ ) {
2049 $callsub = ( caller($index) )[3];
2050 $action = "-> $action";
2051 last;
2052 }
2053 }
2054
f3414019 2055 my $uid = $action_name . $c->counter->{$action_name};
74efc144 2056
a6724a82 2057 # is this a root-level call or a forwarded call?
2058 if ( $callsub =~ /forward$/ ) {
91740f34 2059 my $parent = $c->stack->[-1];
a6724a82 2060
2061 # forward, locate the caller
9c74923d 2062 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 2063 $c->stats->profile(
62a6df80 2064 begin => $action,
69d8f33c 2065 parent => "$parent" . $c->counter->{"$parent"},
2066 uid => $uid,
2067 );
7a7d7af5 2068 }
2069 else {
2070
a6724a82 2071 # forward with no caller may come from a plugin
69d8f33c 2072 $c->stats->profile(
2073 begin => $action,
2074 uid => $uid,
2075 );
7a7d7af5 2076 }
2077 }
a6724a82 2078 else {
62a6df80 2079
a6724a82 2080 # root-level call
69d8f33c 2081 $c->stats->profile(
2082 begin => $action,
2083 uid => $uid,
2084 );
a6724a82 2085 }
dc5f035e 2086 return $action;
7a7d7af5 2087
7a7d7af5 2088}
2089
2090sub _stats_finish_execute {
2091 my ( $c, $info ) = @_;
69d8f33c 2092 $c->stats->profile( end => $info );
7a7d7af5 2093}
2094
b5ecfcf0 2095=head2 $c->finalize
fbcc39ad 2096
e7f1cf73 2097Finalizes the request.
fbcc39ad 2098
2099=cut
2100
2101sub finalize {
2102 my $c = shift;
2103
369c09bc 2104 for my $error ( @{ $c->error } ) {
2105 $c->log->error($error);
2106 }
2107
eb1f4b49 2108 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
2109 # stuff like cometd and websockets
c4df830e 2110
c2fef52f 2111 if($c->request->_has_io_fh) {
74bebe95 2112 $c->log_response;
2113 return;
2114 }
eb1f4b49 2115
5050d7a7 2116 # Allow engine to handle finalize flow (for POE)
e63bdf38 2117 my $engine = $c->engine;
2118 if ( my $code = $engine->can('finalize') ) {
2119 $engine->$code($c);
fbcc39ad 2120 }
5050d7a7 2121 else {
fbcc39ad 2122
5050d7a7 2123 $c->finalize_uploads;
fbcc39ad 2124
5050d7a7 2125 # Error
2126 if ( $#{ $c->error } >= 0 ) {
2127 $c->finalize_error;
2128 }
2129
9c38cb50 2130 $c->finalize_encoding;
89ba65d5 2131 $c->finalize_headers unless $c->response->finalized_headers;
5050d7a7 2132 $c->finalize_body;
2133 }
62a6df80 2134
2bf54936 2135 $c->log_response;
10f204e1 2136
62a6df80 2137 if ($c->use_stats) {
87b41398 2138 my $elapsed = $c->stats->elapsed;
12bf12c0 2139 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 2140 $c->log->info(
62a6df80 2141 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 2142 }
fbcc39ad 2143
2144 return $c->response->status;
2145}
2146
b5ecfcf0 2147=head2 $c->finalize_body
fbcc39ad 2148
e7f1cf73 2149Finalizes body.
fbcc39ad 2150
2151=cut
2152
2153sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
2154
b5ecfcf0 2155=head2 $c->finalize_cookies
fbcc39ad 2156
e7f1cf73 2157Finalizes cookies.
fbcc39ad 2158
2159=cut
2160
147821ea 2161sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 2162
b5ecfcf0 2163=head2 $c->finalize_error
fbcc39ad 2164
df93c9b5 2165Finalizes error. If there is only one error in L</error> and it is an object that
2166does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
2167up the ladder. Otherwise we return the debugging error page (in debug mode) or we
2168return the default error page (production mode).
fbcc39ad 2169
2170=cut
2171
660f9bb0 2172sub finalize_error {
2173 my $c = shift;
2174 if($#{$c->error} > 0) {
2175 $c->engine->finalize_error( $c, @_ );
2176 } else {
2177 my ($error) = @{$c->error};
80172e7d 2178 if ( $c->_handle_http_exception($error) ) {
660f9bb0 2179 # In the case where the error 'knows what it wants', becauses its PSGI
2180 # aware, just rethow and let middleware catch it
2181 $error->can('rethrow') ? $error->rethrow : croak $error;
660f9bb0 2182 } else {
2183 $c->engine->finalize_error( $c, @_ )
2184 }
2185 }
2186}
fbcc39ad 2187
b5ecfcf0 2188=head2 $c->finalize_headers
fbcc39ad 2189
e7f1cf73 2190Finalizes headers.
fbcc39ad 2191
2192=cut
2193
2194sub finalize_headers {
2195 my $c = shift;
2196
e63bdf38 2197 my $response = $c->response; #accessor calls can add up?
2198
fbcc39ad 2199 # Check if we already finalized headers
6680c772 2200 return if $response->finalized_headers;
fbcc39ad 2201
2202 # Handle redirects
e63bdf38 2203 if ( my $location = $response->redirect ) {
fbcc39ad 2204 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 2205 $response->header( Location => $location );
fbcc39ad 2206 }
2207
9629478d 2208 # Remove incorrectly added body and content related meta data when returning
2209 # an information response, or a response the is required to not include a body
2210
fbcc39ad 2211 $c->finalize_cookies;
2212
6adc45cf 2213 # This currently is a NOOP but I don't want to remove it since I guess people
2214 # might have Response subclasses that use it for something... (JNAP)
89ba65d5 2215 $c->response->finalize_headers();
fbcc39ad 2216
2217 # Done
6680c772 2218 $response->finalized_headers(1);
fbcc39ad 2219}
2220
9c38cb50 2221=head2 $c->finalize_encoding
2222
4a64c27b 2223Make sure your body is encoded properly IF you set an encoding. By
566678d0 2224default the encoding is UTF-8 but you can disable it by explicitly setting the
dd096a3a 2225encoding configuration value to undef.
2226
6adc45cf 2227We can only encode when the body is a scalar. Methods for encoding via the
2228streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response>
2229are available).
2230
9c38cb50 2231See L</ENCODING>.
2232
2233=cut
2234
2235sub finalize_encoding {
2236 my $c = shift;
6adc45cf 2237 my $res = $c->res || return;
2238
2239 # Warn if the set charset is different from the one you put into encoding. We need
2240 # to do this early since encodable_response is false for this condition and we need
2241 # to match the debug output for backcompat (there's a test for this...) -JNAP
2242 if(
2243 $res->content_type_charset and $c->encoding and
2244 (uc($c->encoding->mime_name) ne uc($res->content_type_charset))
2245 ) {
2246 my $ct = lc($res->content_type_charset);
2247 $c->log->debug("Catalyst encoding config is set to encode in '" .
2248 $c->encoding->mime_name .
2249 "', content type is '$ct', not encoding ");
2250 }
9c38cb50 2251
6adc45cf 2252 if(
2253 ($res->encodable_response) and
2254 (defined($res->body)) and
2255 (ref(\$res->body) eq 'SCALAR')
2256 ) {
2257 $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
9c38cb50 2258
6adc45cf 2259 # Set the charset if necessary. This might be a bit bonkers since encodable response
2260 # is false when the set charset is not the same as the encoding mimetype (maybe
2261 # confusing action at a distance here..
9c056c82 2262 # Don't try to set the charset if one already exists or if headers are already finalized
6adc45cf 2263 $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
9c056c82 2264 unless($c->res->content_type_charset ||
2265 ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
9c38cb50 2266 }
9c38cb50 2267}
2268
b5ecfcf0 2269=head2 $c->finalize_output
fbcc39ad 2270
2271An alias for finalize_body.
2272
b5ecfcf0 2273=head2 $c->finalize_read
fbcc39ad 2274
e7f1cf73 2275Finalizes the input after reading is complete.
fbcc39ad 2276
2277=cut
2278
2279sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2280
b5ecfcf0 2281=head2 $c->finalize_uploads
fbcc39ad 2282
ae1e6b59 2283Finalizes uploads. Cleans up any temporary files.
fbcc39ad 2284
2285=cut
2286
2287sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2288
b5ecfcf0 2289=head2 $c->get_action( $action, $namespace )
fbcc39ad 2290
e7f1cf73 2291Gets an action in a given namespace.
fbcc39ad 2292
2293=cut
2294
684d10ed 2295sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2296
b5ecfcf0 2297=head2 $c->get_actions( $action, $namespace )
a9dc674c 2298
ae1e6b59 2299Gets all actions of a given name in a namespace and all parent
2300namespaces.
a9dc674c 2301
2302=cut
2303
2304sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2305
e5ce5f04 2306=head2 $app->handle_request( @arguments )
fbcc39ad 2307
e7f1cf73 2308Called to handle each HTTP request.
fbcc39ad 2309
2310=cut
2311
2312sub handle_request {
2313 my ( $class, @arguments ) = @_;
2314
2315 # Always expect worst case!
2316 my $status = -1;
3640641e 2317 try {
dea1884f 2318 if ($class->debug) {
908e3d9e 2319 my $secs = time - $START || 1;
2320 my $av = sprintf '%.3f', $COUNT / $secs;
2321 my $time = localtime time;
2322 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2323 }
908e3d9e 2324
2325 my $c = $class->prepare(@arguments);
2326 $c->dispatch;
62a6df80 2327 $status = $c->finalize;
660f9bb0 2328 } catch {
660f9bb0 2329 #rethow if this can be handled by middleware
80172e7d 2330 if ( $class->_handle_http_exception($_) ) {
6e94698d 2331 $_->can('rethrow') ? $_->rethrow : croak $_;
660f9bb0 2332 }
6e94698d 2333 chomp(my $error = $_);
2334 $class->log->error(qq/Caught exception in engine "$error"/);
3640641e 2335 };
fbcc39ad 2336
2337 $COUNT++;
62a6df80 2338
6680c772 2339 if(my $coderef = $class->log->can('_flush')){
2340 $class->log->$coderef();
2341 }
fbcc39ad 2342 return $status;
2343}
2344
d536010b 2345=head2 $class->prepare( @arguments )
fbcc39ad 2346
ae1e6b59 2347Creates a Catalyst context from an engine-specific request (Apache, CGI,
2348etc.).
fbcc39ad 2349
2350=cut
2351
398f13db 2352has _uploadtmp => (
2353 is => 'ro',
2354 predicate => '_has_uploadtmp',
2355);
2356
fbcc39ad 2357sub prepare {
2358 my ( $class, @arguments ) = @_;
2359
6680c772 2360 # XXX
2361 # After the app/ctxt split, this should become an attribute based on something passed
2362 # into the application.
3cec521a 2363 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2364
398f13db 2365 my $uploadtmp = $class->config->{uploadtmp};
2366 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2367
258733f1 2368 $c->response->_context($c);
2369
395037a2 2370 $c->stats($class->stats_class->new)->enable($c->use_stats);
ec4d7259 2371
4f0b7cf1 2372 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2373 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2374 }
2375
3640641e 2376 try {
2377 # Allow engine to direct the prepare flow (for POE)
2378 if ( my $prepare = $c->engine->can('prepare') ) {
2379 $c->engine->$prepare( $c, @arguments );
2380 }
2381 else {
2382 $c->prepare_request(@arguments);
2383 $c->prepare_connection;
2384 $c->prepare_query_parameters;
41aaa5d6 2385 $c->prepare_headers; # Just hooks, no longer needed - they just
2386 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2387 $c->prepare_path;
2388
2389 # Prepare the body for reading, either by prepare_body
2390 # or the user, if they are using $c->read
2391 $c->prepare_read;
2392
2393 # Parse the body unless the user wants it on-demand
2394 unless ( ref($c)->config->{parse_on_demand} ) {
2395 $c->prepare_body;
2396 }
878b821c 2397 }
676bed72 2398 $c->prepare_action;
5050d7a7 2399 }
3640641e 2400 # VERY ugly and probably shouldn't rely on ->finalize actually working
2401 catch {
2402 # failed prepare is always due to an invalid request, right?
2403 $c->response->status(400);
2404 $c->response->content_type('text/plain');
2405 $c->response->body('Bad Request');
5e25c01f 2406 # Note we call finalize and then die here, which escapes
2407 # finalize being called in the enclosing block..
2408 # It in fact couldn't be called, as we don't return $c..
2409 # This is a mess - but I'm unsure you can fix this without
2410 # breaking compat for people doing crazy things (we should set
2411 # the 400 and just return the ctx here IMO, letting finalize get called
2412 # above...
3640641e 2413 $c->finalize;
2414 die $_;
2415 };
fbcc39ad 2416
10f204e1 2417 $c->log_request;
fbcc39ad 2418
2419 return $c;
2420}
2421
b5ecfcf0 2422=head2 $c->prepare_action
fbcc39ad 2423
b4b01a8a 2424Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2425
2426=cut
2427
9c38cb50 2428sub prepare_action {
2429 my $c = shift;
2430 my $ret = $c->dispatcher->prepare_action( $c, @_);
2431
2432 if($c->encoding) {
2433 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2434 $_ = $c->_handle_param_unicode_decoding($_);
2435 }
2436 }
2437
2438 return $ret;
2439}
2440
fbcc39ad 2441
b5ecfcf0 2442=head2 $c->prepare_body
fbcc39ad 2443
e7f1cf73 2444Prepares message body.
fbcc39ad 2445
2446=cut
2447
2448sub prepare_body {
2449 my $c = shift;
2450
0f56bbcf 2451 return if $c->request->_has_body;
fbcc39ad 2452
2453 # Initialize on-demand data
2454 $c->engine->prepare_body( $c, @_ );
2455 $c->prepare_parameters;
2456 $c->prepare_uploads;
fbcc39ad 2457}
2458
b5ecfcf0 2459=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2460
e7f1cf73 2461Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2462
b4b01a8a 2463See L<Catalyst::Engine>.
2464
4bd82c41 2465=cut
2466
4f5ebacd 2467sub prepare_body_chunk {
2468 my $c = shift;
4bd82c41 2469 $c->engine->prepare_body_chunk( $c, @_ );
2470}
2471
b5ecfcf0 2472=head2 $c->prepare_body_parameters
fbcc39ad 2473
e7f1cf73 2474Prepares body parameters.
fbcc39ad 2475
2476=cut
2477
2478sub prepare_body_parameters {
2479 my $c = shift;
b9d96e27 2480 $c->request->prepare_body_parameters( $c, @_ );
fbcc39ad 2481}
2482
b5ecfcf0 2483=head2 $c->prepare_connection
fbcc39ad 2484
e7f1cf73 2485Prepares connection.
fbcc39ad 2486
2487=cut
2488
2489sub prepare_connection {
2490 my $c = shift;
817ed8ab 2491 $c->request->prepare_connection($c);
fbcc39ad 2492}
2493
b5ecfcf0 2494=head2 $c->prepare_cookies
fbcc39ad 2495
41aaa5d6 2496Prepares cookies by ensuring that the attribute on the request
2497object has been built.
fbcc39ad 2498
2499=cut
2500
41aaa5d6 2501sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2502
b5ecfcf0 2503=head2 $c->prepare_headers
fbcc39ad 2504
41aaa5d6 2505Prepares request headers by ensuring that the attribute on the request
2506object has been built.
fbcc39ad 2507
2508=cut
2509
41aaa5d6 2510sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2511
b5ecfcf0 2512=head2 $c->prepare_parameters
fbcc39ad 2513
e7f1cf73 2514Prepares parameters.
fbcc39ad 2515
2516=cut
2517
2518sub prepare_parameters {
2519 my $c = shift;
2520 $c->prepare_body_parameters;
2521 $c->engine->prepare_parameters( $c, @_ );
2522}
2523
b5ecfcf0 2524=head2 $c->prepare_path
fbcc39ad 2525
e7f1cf73 2526Prepares path and base.
fbcc39ad 2527
2528=cut
2529
2530sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2531
b5ecfcf0 2532=head2 $c->prepare_query_parameters
fbcc39ad 2533
e7f1cf73 2534Prepares query parameters.
fbcc39ad 2535
2536=cut
2537
2538sub prepare_query_parameters {
2539 my $c = shift;
2540
2541 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2542}
fbcc39ad 2543
10f204e1 2544=head2 $c->log_request
2545
2546Writes information about the request to the debug logs. This includes:
2547
2548=over 4
2549
854e5dcd 2550=item * Request method, path, and remote IP address
10f204e1 2551
2552=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2553
e7cbe1bf 2554=item * Request parameters
10f204e1 2555
2556=item * File uploads
2557
2558=back
fbcc39ad 2559
2560=cut
2561
10f204e1 2562sub log_request {
2563 my $c = shift;
fbcc39ad 2564
10f204e1 2565 return unless $c->debug;
fbcc39ad 2566
2bf54936 2567 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2568 my $request = $dump->[1];
e7cbe1bf 2569
2570 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2571 $method ||= '';
2572 $path = '/' unless length $path;
2573 $address ||= '';
0ca510f0 2574
2575 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
2576 $path = decode_utf8($path);
2577
10f204e1 2578 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2579
3a4abdb3 2580 $c->log_request_headers($request->headers);
e7cbe1bf 2581
2582 if ( my $keywords = $request->query_keywords ) {
10f204e1 2583 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2584 }
10f204e1 2585
9c74923d 2586 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2587
e7cbe1bf 2588 $c->log_request_uploads($request);
fbcc39ad 2589}
2590
10f204e1 2591=head2 $c->log_response
fbcc39ad 2592
75b65816 2593Writes information about the response to the debug logs by calling
2594C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2595
2596=cut
2597
75b65816 2598sub log_response {
2599 my $c = shift;
fbcc39ad 2600
75b65816 2601 return unless $c->debug;
fbcc39ad 2602
75b65816 2603 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2604 my $response = $dump->[1];
2605
2606 $c->log_response_status_line($response);
2607 $c->log_response_headers($response->headers);
2608}
2609
2610=head2 $c->log_response_status_line($response)
2611
2612Writes one line of information about the response to the debug logs. This includes:
10f204e1 2613
2614=over 4
2615
2616=item * Response status code
2617
3a4abdb3 2618=item * Content-Type header (if present)
2619
2620=item * Content-Length header (if present)
10f204e1 2621
2622=back
fbcc39ad 2623
2624=cut
2625
75b65816 2626sub log_response_status_line {
2627 my ($c, $response) = @_;
fbcc39ad 2628
697bab77 2629 $c->log->debug(
2630 sprintf(
2631 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2632 $response->status || 'unknown',
2633 $response->headers->header('Content-Type') || 'unknown',
2634 $response->headers->header('Content-Length') || 'unknown'
2635 )
2636 );
10f204e1 2637}
fbcc39ad 2638
75b65816 2639=head2 $c->log_response_headers($headers);
2640
8ad6fd58 2641Hook method which can be wrapped by plugins to log the response headers.
75b65816 2642No-op in the default implementation.
fbcc39ad 2643
2644=cut
2645
75b65816 2646sub log_response_headers {}
fbcc39ad 2647
10f204e1 2648=head2 $c->log_request_parameters( query => {}, body => {} )
2649
2650Logs request parameters to debug logs
2651
10f204e1 2652=cut
2653
2654sub log_request_parameters {
2655 my $c = shift;
2656 my %all_params = @_;
2657
2bf54936 2658 return unless $c->debug;
e7cbe1bf 2659
10f204e1 2660 my $column_width = Catalyst::Utils::term_width() - 44;
2661 foreach my $type (qw(query body)) {
2bf54936 2662 my $params = $all_params{$type};
2663 next if ! keys %$params;
10f204e1 2664 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2665 for my $key ( sort keys %$params ) {
2666 my $param = $params->{$key};
10f204e1 2667 my $value = defined($param) ? $param : '';
2668 $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2669 }
2670 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2671 }
2672}
2673
2674=head2 $c->log_request_uploads
2675
2676Logs file uploads included in the request to the debug logs.
854e5dcd 2677The parameter name, filename, file type, and file size are all included in
10f204e1 2678the debug logs.
2679
2680=cut
fbcc39ad 2681
10f204e1 2682sub log_request_uploads {
2683 my $c = shift;
2bf54936 2684 my $request = shift;
e7cbe1bf 2685 return unless $c->debug;
2686 my $uploads = $request->uploads;
10f204e1 2687 if ( keys %$uploads ) {
8c113188 2688 my $t = Text::SimpleTable->new(
34d28dfd 2689 [ 12, 'Parameter' ],
2690 [ 26, 'Filename' ],
8c113188 2691 [ 18, 'Type' ],
2692 [ 9, 'Size' ]
2693 );
10f204e1 2694 for my $key ( sort keys %$uploads ) {
2695 my $upload = $uploads->{$key};
fbcc39ad 2696 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2697 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2698 }
2699 }
2700 $c->log->debug( "File Uploads are:\n" . $t->draw );
2701 }
2702}
2703
3a4abdb3 2704=head2 $c->log_request_headers($headers);
2705
2706Hook method which can be wrapped by plugins to log the request headers.
2707No-op in the default implementation.
2708
2709=cut
2710
2711sub log_request_headers {}
2712
10f204e1 2713=head2 $c->log_headers($type => $headers)
2714
e7cbe1bf 2715Logs L<HTTP::Headers> (either request or response) to the debug logs.
10f204e1 2716
2717=cut
2718
2719sub log_headers {
2720 my $c = shift;
2721 my $type = shift;
2722 my $headers = shift; # an HTTP::Headers instance
2723
e7cbe1bf 2724 return unless $c->debug;
10f204e1 2725
f0e9921a 2726 my $column_width = Catalyst::Utils::term_width() - 28;
2727 my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
e7cbe1bf 2728 $headers->scan(
10f204e1 2729 sub {
2730 my ( $name, $value ) = @_;
2731 $t->row( $name, $value );
2732 }
2733 );
2734 $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2735}
2736
10f204e1 2737
2738=head2 $c->prepare_read
2739
2740Prepares the input for reading.
2741
2742=cut
2743
2744sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2745
2746=head2 $c->prepare_request
2747
2748Prepares the engine request.
2749
2750=cut
2751
2752sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2753
2754=head2 $c->prepare_uploads
2755
2756Prepares uploads.
2757
2758=cut
2759
2760sub prepare_uploads {
2761 my $c = shift;
10f204e1 2762 $c->engine->prepare_uploads( $c, @_ );
2763}
2764
b5ecfcf0 2765=head2 $c->prepare_write