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