Merge branch 'pr/154' into release-candidates/rc-5.90116
[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;
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
7dac038c 168#I imagine that very few of these really
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!
9d8747f5 208our $VERSION = '5.90115';
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 {
1435 ref $_ eq 'CODE' ?
1436 "Inline Coderef" :
ef5ad930 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
6b9f9ef7 1604 my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
1605
02336198 1606 unless(blessed $path) {
7064f69b 1607 if (defined($path) and $path =~ s/#(.+)$//) {
02336198 1608 if(defined($1) and $fragment) {
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)) {
1643 carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'";
86a399db 1644 return;
c1192f1e 1645 }
1646 }
1647
1648 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1649 if (not defined $path) {
1650 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1651 if $c->debug;
1652 return undef;
1653 }
81e75875 1654 $path = '/' if $path eq '';
c1192f1e 1655
1656 # At this point @encoded_args is the remaining Args (all captures removed).
86a399db 1657 if($expanded_action->has_args_constraints) {
c042d18d 1658 unless($expanded_action->match_args($c,\@args)) {
1659 carp "args [@args] do not match the type constraints in action '$expanded_action'";
86a399db 1660 return;
c1192f1e 1661 }
1662 }
ea0e58d9 1663 }
1664
c042d18d 1665 unshift(@args, $path);
51674a63 1666
1667 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1668 my $namespace = $c->namespace;
1669 if (defined $path) { # cheesy hack to handle path '../foo'
c042d18d 1670 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1671 }
c042d18d 1672 unshift(@args, $namespace || '');
51674a63 1673 }
62a6df80 1674
189e2a51 1675 # join args with '/', or a blank string
c042d18d 1676 my $args = join('/', grep { defined($_) } @args);
51674a63 1677 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1678 $args =~ s!^/+!!;
f9451270 1679
1680 my ($base, $class) = ('/', 'URI::_generic');
1681 if(blessed($c)) {
1682 $base = $c->req->base;
342d2169 1683 if($target_action) {
1684 $target_action = $c->dispatcher->expand_action($target_action);
1685 if(my $s = $target_action->scheme) {
1686 $s = lc($s);
1687 $class = "URI::$s";
1688 $base->scheme($s);
1689 } else {
1690 $class = ref($base);
1691 }
1692 } else {
1693 $class = ref($base);
1694 }
1695
f9451270 1696 $base =~ s{(?<!/)$}{/};
1697 }
51674a63 1698
1699 my $query = '';
51674a63 1700 if (my @keys = keys %$params) {
1701 # somewhat lifted from URI::_query's query_form
1702 $query = '?'.join('&', map {
2f381252 1703 my $val = $params->{$_};
901b4331 1704 my $key = encode_utf8($_);
1705 # using the URI::Escape pattern here so utf8 chars survive
1706 $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1707 $key =~ s/ /+/g;
1708
51674a63 1709 $val = '' unless defined $val;
1710 (map {
901b4331 1711 my $param = encode_utf8($_);
51674a63 1712 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1713 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1714 $param =~ s/ /+/g;
5c779e98 1715
901b4331 1716 "${key}=$param";
1717 } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1718 } @keys);
1719 }
1720
d2b583c3 1721 $base = encode_utf8 $base;
1722 $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1723 $args = encode_utf8 $args;
1724 $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
3a6d7f15 1725
6b9f9ef7 1726 if(defined $fragment) {
02336198 1727 if(blessed $path) {
1728 $fragment = encode_utf8(${$fragment});
1729 $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1730 $fragment =~ s/ /+/g;
1731 }
6b9f9ef7 1732 $query .= "#$fragment";
1733 }
3a6d7f15 1734
51674a63 1735 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1736 $res;
fbcc39ad 1737}
1738
25d61080 1739=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1740
25d61080 1741=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1742
1743=over
1744
1745=item $path
1746
1747A private path to the Catalyst action you want to create a URI for.
1748
1749This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1750>> and passing the resulting C<$action> and the remaining arguments to C<<
1751$c->uri_for >>.
1752
1753You can also pass in a Catalyst::Action object, in which case it is passed to
1754C<< $c->uri_for >>.
1755
c9ec25f8 1756Note 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.
1757
1758For example, if the action looks like:
1759
1760 package MyApp::Controller::Users;
1761
1762 sub lst : Path('the-list') {}
1763
1764You can use:
1765
1766 $c->uri_for_action('/users/lst')
1767
1768and it will create the URI /users/the-list.
1769
25d61080 1770=item \@captures_and_args?
1771
1772Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1773and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1774to interpolate all the parameters in the URI.
1775
1776=item @args?
1777
942572d7 1778Optional list of extra arguments - can be supplied in the
1779C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1780code.
25d61080 1781
942572d7 1782Your action can have zero, a fixed or a variable number of args (e.g.
1783C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1784
1785=item \%query_values?
1786
1787Optional array reference of query parameters to append. E.g.
1788
1789 { foo => 'bar' }
1790
1791will generate
1792
1793 /rest/of/your/uri?foo=bar
1794
833b385e 1795=back
1796
1797=cut
1798
1799sub uri_for_action {
1800 my ( $c, $path, @args ) = @_;
62a6df80 1801 my $action = blessed($path)
1802 ? $path
833b385e 1803 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1804 unless (defined $action) {
1805 croak "Can't find action for path '$path'";
1806 }
833b385e 1807 return $c->uri_for( $action, @args );
1808}
1809
b5ecfcf0 1810=head2 $c->welcome_message
ab2374d3 1811
1812Returns the Catalyst welcome HTML page.
1813
1814=cut
1815
1816sub welcome_message {
bf1f2c60 1817 my $c = shift;
1818 my $name = $c->config->{name};
1819 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1820 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1821 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1822 return <<"EOF";
80cdbbff 1823<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1824 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1825<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1826 <head>
85d9fce6 1827 <meta http-equiv="Content-Language" content="en" />
1828 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1829 <title>$name on Catalyst $VERSION</title>
1830 <style type="text/css">
1831 body {
ab2374d3 1832 color: #000;
1833 background-color: #eee;
1834 }
1835 div#content {
1836 width: 640px;
80cdbbff 1837 margin-left: auto;
1838 margin-right: auto;
ab2374d3 1839 margin-top: 10px;
1840 margin-bottom: 10px;
1841 text-align: left;
1842 background-color: #ccc;
1843 border: 1px solid #aaa;
ab2374d3 1844 }
d84c4dab 1845 p, h1, h2 {
ab2374d3 1846 margin-left: 20px;
1847 margin-right: 20px;
16215972 1848 font-family: verdana, tahoma, sans-serif;
ab2374d3 1849 }
d84c4dab 1850 a {
1851 font-family: verdana, tahoma, sans-serif;
1852 }
d114e033 1853 :link, :visited {
1854 text-decoration: none;
1855 color: #b00;
1856 border-bottom: 1px dotted #bbb;
1857 }
1858 :link:hover, :visited:hover {
d114e033 1859 color: #555;
1860 }
ab2374d3 1861 div#topbar {
1862 margin: 0px;
1863 }
3e82a295 1864 pre {
3e82a295 1865 margin: 10px;
1866 padding: 8px;
1867 }
ab2374d3 1868 div#answers {
1869 padding: 8px;
1870 margin: 10px;
d114e033 1871 background-color: #fff;
ab2374d3 1872 border: 1px solid #aaa;
ab2374d3 1873 }
1874 h1 {
33108eaf 1875 font-size: 0.9em;
1876 font-weight: normal;
ab2374d3 1877 text-align: center;
1878 }
1879 h2 {
1880 font-size: 1.0em;
1881 }
1882 p {
1883 font-size: 0.9em;
1884 }
ae7c5252 1885 p img {
1886 float: right;
1887 margin-left: 10px;
1888 }
9619f23c 1889 span#appname {
1890 font-weight: bold;
33108eaf 1891 font-size: 1.6em;
ab2374d3 1892 }
1893 </style>
1894 </head>
1895 <body>
1896 <div id="content">
1897 <div id="topbar">
9619f23c 1898 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1899 $VERSION</h1>
ab2374d3 1900 </div>
1901 <div id="answers">
ae7c5252 1902 <p>
80cdbbff 1903 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1904 </p>
596aaffe 1905 <p>Welcome to the world of Catalyst.
f92fd545 1906 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1907 framework will make web development something you had
60dd6e1d 1908 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1909 <h2>What to do now?</h2>
4b8cb778 1910 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1911 We do, however, provide you with a few starting points.</p>
1912 <p>If you want to jump right into web development with Catalyst
2f381252 1913 you might want to start with a tutorial.</p>
80267996 1914<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1915</pre>
1916<p>Afterwards you can go on to check out a more complete look at our features.</p>
1917<pre>
80267996 1918<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1919<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1920</code></pre>
ab2374d3 1921 <h2>What to do next?</h2>
f5681c92 1922 <p>Next it's time to write an actual application. Use the
80267996 1923 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1924 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1925 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1926 they can save you a lot of work.</p>
c5f31918 1927 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1928 <p>Also, be sure to check out the vast and growing
802bf2cb 1929 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1930 you are likely to find what you need there.
f5681c92 1931 </p>
1932
82245cc4 1933 <h2>Need help?</h2>
f5681c92 1934 <p>Catalyst has a very active community. Here are the main places to
1935 get in touch with us.</p>
16215972 1936 <ul>
1937 <li>
2b9a7d76 1938 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1939 </li>
1940 <li>
6d4c3368 1941 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1942 </li>
1943 <li>
4eaf7c88 1944 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1945 </li>
1946 </ul>
ab2374d3 1947 <h2>In conclusion</h2>
62a6df80 1948 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1949 as we enjoyed making it. Please contact us if you have ideas
1950 for improvement or other feedback.</p>
ab2374d3 1951 </div>
1952 </div>
1953 </body>
1954</html>
1955EOF
1956}
1957
aee7cdcc 1958=head2 run_options
1959
1960Contains a hash of options passed from the application script, including
c2c8d3cb 1961the original ARGV the script received, the processed values from that
aee7cdcc 1962ARGV and any extra arguments to the script which were not processed.
1963
1964This can be used to add custom options to your application's scripts
1965and setup your application differently depending on the values of these
1966options.
1967
fbcc39ad 1968=head1 INTERNAL METHODS
1969
ae1e6b59 1970These methods are not meant to be used by end users.
1971
b5ecfcf0 1972=head2 $c->components
fbcc39ad 1973
e7f1cf73 1974Returns a hash of components.
fbcc39ad 1975
b5ecfcf0 1976=head2 $c->context_class
1f9cb7c1 1977
e7f1cf73 1978Returns or sets the context class.
1f9cb7c1 1979
b5ecfcf0 1980=head2 $c->counter
fbcc39ad 1981
ae1e6b59 1982Returns a hashref containing coderefs and execution counts (needed for
1983deep recursion detection).
fbcc39ad 1984
b5ecfcf0 1985=head2 $c->depth
fbcc39ad 1986
e7f1cf73 1987Returns the number of actions on the current internal execution stack.
fbcc39ad 1988
b5ecfcf0 1989=head2 $c->dispatch
fbcc39ad 1990
e7f1cf73 1991Dispatches a request to actions.
fbcc39ad 1992
1993=cut
1994
1995sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1996
b5ecfcf0 1997=head2 $c->dispatcher_class
1f9cb7c1 1998
e7f1cf73 1999Returns or sets the dispatcher class.
1f9cb7c1 2000
b5ecfcf0 2001=head2 $c->dump_these
7f92deef 2002
ae1e6b59 2003Returns a list of 2-element array references (name, structure) pairs
2004that will be dumped on the error page in debug mode.
7f92deef 2005
2006=cut
2007
2008sub dump_these {
2009 my $c = shift;
62a6df80 2010 [ Request => $c->req ],
2011 [ Response => $c->res ],
052a2d89 2012 [ Stash => $c->stash ],
2013 [ Config => $c->config ];
7f92deef 2014}
2015
b5ecfcf0 2016=head2 $c->engine_class
1f9cb7c1 2017
e7f1cf73 2018Returns or sets the engine class.
1f9cb7c1 2019
b5ecfcf0 2020=head2 $c->execute( $class, $coderef )
fbcc39ad 2021
0ef52a96 2022Execute a coderef in given class and catch exceptions. Errors are available
2023via $c->error.
fbcc39ad 2024
2025=cut
2026
2027sub execute {
2028 my ( $c, $class, $code ) = @_;
858828dd 2029 $class = $c->component($class) || $class;
e459bd03 2030 #$c->state(0);
a0eca838 2031
197bd788 2032 if ( $c->depth >= $RECURSION ) {
f3414019 2033 my $action = $code->reverse();
91d08727 2034 $action = "/$action" unless $action =~ /->/;
f3414019 2035 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 2036 $c->log->error($error);
2037 $c->error($error);
2038 $c->state(0);
2039 return $c->state;
2040 }
2041
dc5f035e 2042 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 2043
8767c5a3 2044 push( @{ $c->stack }, $code );
62a6df80 2045
6f3df815 2046 no warnings 'recursion';
524b0e1c 2047 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
2048 # I have no idea how, ergo $ret (which appears to fix the issue)
2049 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 2050
dc5f035e 2051 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 2052
a6724a82 2053 my $last = pop( @{ $c->stack } );
fbcc39ad 2054
2055 if ( my $error = $@ ) {
e25e23a7 2056 #rethow if this can be handled by middleware
80172e7d 2057 if ( $c->_handle_http_exception($error) ) {
30e84ba1 2058 foreach my $err (@{$c->error}) {
2059 $c->log->error($err);
2060 }
2061 $c->clear_errors;
2062 $c->log->_flush if $c->log->can('_flush');
2063
e25e23a7 2064 $error->can('rethrow') ? $error->rethrow : croak $error;
2065 }
79f5d571 2066 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 2067 $error->rethrow if $c->depth > 1;
2f381252 2068 }
79f5d571 2069 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 2070 $error->rethrow if $c->depth > 0;
55424863 2071 }
fbcc39ad 2072 else {
2073 unless ( ref $error ) {
91d08727 2074 no warnings 'uninitialized';
fbcc39ad 2075 chomp $error;
f59def82 2076 my $class = $last->class;
2077 my $name = $last->name;
2078 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 2079 }
fbcc39ad 2080 $c->error($error);
fbcc39ad 2081 }
e459bd03 2082 #$c->state(0);
fbcc39ad 2083 }
2084 return $c->state;
2085}
2086
7a7d7af5 2087sub _stats_start_execute {
2088 my ( $c, $code ) = @_;
df960201 2089 my $appclass = ref($c) || $c;
a6724a82 2090 return if ( ( $code->name =~ /^_.*/ )
df960201 2091 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 2092
f3414019 2093 my $action_name = $code->reverse();
2094 $c->counter->{$action_name}++;
7a7d7af5 2095
f3414019 2096 my $action = $action_name;
a6724a82 2097 $action = "/$action" unless $action =~ /->/;
2098
7a7d7af5 2099 # determine if the call was the result of a forward
2100 # this is done by walking up the call stack and looking for a calling
2101 # sub of Catalyst::forward before the eval
2102 my $callsub = q{};
2103 for my $index ( 2 .. 11 ) {
2104 last
2105 if ( ( caller($index) )[0] eq 'Catalyst'
2106 && ( caller($index) )[3] eq '(eval)' );
2107
2108 if ( ( caller($index) )[3] =~ /forward$/ ) {
2109 $callsub = ( caller($index) )[3];
2110 $action = "-> $action";
2111 last;
2112 }
2113 }
2114
f3414019 2115 my $uid = $action_name . $c->counter->{$action_name};
74efc144 2116
a6724a82 2117 # is this a root-level call or a forwarded call?
2118 if ( $callsub =~ /forward$/ ) {
91740f34 2119 my $parent = $c->stack->[-1];
a6724a82 2120
2121 # forward, locate the caller
9c74923d 2122 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 2123 $c->stats->profile(
62a6df80 2124 begin => $action,
69d8f33c 2125 parent => "$parent" . $c->counter->{"$parent"},
2126 uid => $uid,
2127 );
7a7d7af5 2128 }
2129 else {
2130
a6724a82 2131 # forward with no caller may come from a plugin
69d8f33c 2132 $c->stats->profile(
2133 begin => $action,
2134 uid => $uid,
2135 );
7a7d7af5 2136 }
2137 }
a6724a82 2138 else {
62a6df80 2139
a6724a82 2140 # root-level call
69d8f33c 2141 $c->stats->profile(
2142 begin => $action,
2143 uid => $uid,
2144 );
a6724a82 2145 }
dc5f035e 2146 return $action;
7a7d7af5 2147
7a7d7af5 2148}
2149
2150sub _stats_finish_execute {
2151 my ( $c, $info ) = @_;
69d8f33c 2152 $c->stats->profile( end => $info );
7a7d7af5 2153}
2154
b5ecfcf0 2155=head2 $c->finalize
fbcc39ad 2156
e7f1cf73 2157Finalizes the request.
fbcc39ad 2158
2159=cut
2160
2161sub finalize {
2162 my $c = shift;
2163
369c09bc 2164 for my $error ( @{ $c->error } ) {
2165 $c->log->error($error);
2166 }
2167
eb1f4b49 2168 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
2169 # stuff like cometd and websockets
c4df830e 2170
c2fef52f 2171 if($c->request->_has_io_fh) {
74bebe95 2172 $c->log_response;
2173 return;
2174 }
eb1f4b49 2175
5050d7a7 2176 # Allow engine to handle finalize flow (for POE)
e63bdf38 2177 my $engine = $c->engine;
2178 if ( my $code = $engine->can('finalize') ) {
2179 $engine->$code($c);
fbcc39ad 2180 }
5050d7a7 2181 else {
fbcc39ad 2182
5050d7a7 2183 $c->finalize_uploads;
fbcc39ad 2184
5050d7a7 2185 # Error
2186 if ( $#{ $c->error } >= 0 ) {
2187 $c->finalize_error;
2188 }
2189
9c38cb50 2190 $c->finalize_encoding;
89ba65d5 2191 $c->finalize_headers unless $c->response->finalized_headers;
5050d7a7 2192 $c->finalize_body;
2193 }
62a6df80 2194
2bf54936 2195 $c->log_response;
10f204e1 2196
62a6df80 2197 if ($c->use_stats) {
87b41398 2198 my $elapsed = $c->stats->elapsed;
12bf12c0 2199 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 2200 $c->log->info(
62a6df80 2201 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 2202 }
fbcc39ad 2203
2204 return $c->response->status;
2205}
2206
b5ecfcf0 2207=head2 $c->finalize_body
fbcc39ad 2208
e7f1cf73 2209Finalizes body.
fbcc39ad 2210
2211=cut
2212
2213sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
2214
b5ecfcf0 2215=head2 $c->finalize_cookies
fbcc39ad 2216
e7f1cf73 2217Finalizes cookies.
fbcc39ad 2218
2219=cut
2220
147821ea 2221sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 2222
b5ecfcf0 2223=head2 $c->finalize_error
fbcc39ad 2224
df93c9b5 2225Finalizes error. If there is only one error in L</error> and it is an object that
2226does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
2227up the ladder. Otherwise we return the debugging error page (in debug mode) or we
2228return the default error page (production mode).
fbcc39ad 2229
2230=cut
2231
660f9bb0 2232sub finalize_error {
2233 my $c = shift;
2234 if($#{$c->error} > 0) {
2235 $c->engine->finalize_error( $c, @_ );
2236 } else {
2237 my ($error) = @{$c->error};
80172e7d 2238 if ( $c->_handle_http_exception($error) ) {
660f9bb0 2239 # In the case where the error 'knows what it wants', becauses its PSGI
2240 # aware, just rethow and let middleware catch it
2241 $error->can('rethrow') ? $error->rethrow : croak $error;
660f9bb0 2242 } else {
2243 $c->engine->finalize_error( $c, @_ )
2244 }
2245 }
2246}
fbcc39ad 2247
b5ecfcf0 2248=head2 $c->finalize_headers
fbcc39ad 2249
e7f1cf73 2250Finalizes headers.
fbcc39ad 2251
2252=cut
2253
2254sub finalize_headers {
2255 my $c = shift;
2256
e63bdf38 2257 my $response = $c->response; #accessor calls can add up?
2258
fbcc39ad 2259 # Check if we already finalized headers
6680c772 2260 return if $response->finalized_headers;
fbcc39ad 2261
2262 # Handle redirects
e63bdf38 2263 if ( my $location = $response->redirect ) {
fbcc39ad 2264 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 2265 $response->header( Location => $location );
fbcc39ad 2266 }
2267
9629478d 2268 # Remove incorrectly added body and content related meta data when returning
2269 # an information response, or a response the is required to not include a body
2270
fbcc39ad 2271 $c->finalize_cookies;
2272
6adc45cf 2273 # This currently is a NOOP but I don't want to remove it since I guess people
2274 # might have Response subclasses that use it for something... (JNAP)
89ba65d5 2275 $c->response->finalize_headers();
fbcc39ad 2276
2277 # Done
6680c772 2278 $response->finalized_headers(1);
fbcc39ad 2279}
2280
9c38cb50 2281=head2 $c->finalize_encoding
2282
4a64c27b 2283Make sure your body is encoded properly IF you set an encoding. By
566678d0 2284default the encoding is UTF-8 but you can disable it by explicitly setting the
dd096a3a 2285encoding configuration value to undef.
2286
6adc45cf 2287We can only encode when the body is a scalar. Methods for encoding via the
2288streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response>
2289are available).
2290
9c38cb50 2291See L</ENCODING>.
2292
2293=cut
2294
2295sub finalize_encoding {
2296 my $c = shift;
6adc45cf 2297 my $res = $c->res || return;
2298
2299 # Warn if the set charset is different from the one you put into encoding. We need
2300 # to do this early since encodable_response is false for this condition and we need
2301 # to match the debug output for backcompat (there's a test for this...) -JNAP
2302 if(
2303 $res->content_type_charset and $c->encoding and
2304 (uc($c->encoding->mime_name) ne uc($res->content_type_charset))
2305 ) {
2306 my $ct = lc($res->content_type_charset);
2307 $c->log->debug("Catalyst encoding config is set to encode in '" .
2308 $c->encoding->mime_name .
2309 "', content type is '$ct', not encoding ");
2310 }
9c38cb50 2311
6adc45cf 2312 if(
2313 ($res->encodable_response) and
2314 (defined($res->body)) and
2315 (ref(\$res->body) eq 'SCALAR')
2316 ) {
32e66829 2317 # if you are finding yourself here and your body is already encoded correctly
2318 # and you want to turn this off, use $c->clear_encoding to prevent encoding
2319 # at this step, or set encoding to undef in the config to do so for the whole
2320 # application. See the ENCODING documentaiton for better notes.
6adc45cf 2321 $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
9c38cb50 2322
6adc45cf 2323 # Set the charset if necessary. This might be a bit bonkers since encodable response
2324 # is false when the set charset is not the same as the encoding mimetype (maybe
2325 # confusing action at a distance here..
9c056c82 2326 # Don't try to set the charset if one already exists or if headers are already finalized
6adc45cf 2327 $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
9c056c82 2328 unless($c->res->content_type_charset ||
2329 ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
9c38cb50 2330 }
9c38cb50 2331}
2332
b5ecfcf0 2333=head2 $c->finalize_output
fbcc39ad 2334
2335An alias for finalize_body.
2336
b5ecfcf0 2337=head2 $c->finalize_read
fbcc39ad 2338
e7f1cf73 2339Finalizes the input after reading is complete.
fbcc39ad 2340
2341=cut
2342
2343sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2344
b5ecfcf0 2345=head2 $c->finalize_uploads
fbcc39ad 2346
ae1e6b59 2347Finalizes uploads. Cleans up any temporary files.
fbcc39ad 2348
2349=cut
2350
2351sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2352
b5ecfcf0 2353=head2 $c->get_action( $action, $namespace )
fbcc39ad 2354
e7f1cf73 2355Gets an action in a given namespace.
fbcc39ad 2356
2357=cut
2358
684d10ed 2359sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2360
b5ecfcf0 2361=head2 $c->get_actions( $action, $namespace )
a9dc674c 2362
ae1e6b59 2363Gets all actions of a given name in a namespace and all parent
2364namespaces.
a9dc674c 2365
2366=cut
2367
2368sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2369
e5ce5f04 2370=head2 $app->handle_request( @arguments )
fbcc39ad 2371
e7f1cf73 2372Called to handle each HTTP request.
fbcc39ad 2373
2374=cut
2375
2376sub handle_request {
2377 my ( $class, @arguments ) = @_;
2378
2379 # Always expect worst case!
2380 my $status = -1;
3640641e 2381 try {
dea1884f 2382 if ($class->debug) {
908e3d9e 2383 my $secs = time - $START || 1;
2384 my $av = sprintf '%.3f', $COUNT / $secs;
2385 my $time = localtime time;
2386 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2387 }
908e3d9e 2388
2389 my $c = $class->prepare(@arguments);
2390 $c->dispatch;
62a6df80 2391 $status = $c->finalize;
660f9bb0 2392 } catch {
660f9bb0 2393 #rethow if this can be handled by middleware
80172e7d 2394 if ( $class->_handle_http_exception($_) ) {
6e94698d 2395 $_->can('rethrow') ? $_->rethrow : croak $_;
660f9bb0 2396 }
6e94698d 2397 chomp(my $error = $_);
2398 $class->log->error(qq/Caught exception in engine "$error"/);
3640641e 2399 };
fbcc39ad 2400
2401 $COUNT++;
62a6df80 2402
6680c772 2403 if(my $coderef = $class->log->can('_flush')){
2404 $class->log->$coderef();
2405 }
fbcc39ad 2406 return $status;
2407}
2408
d536010b 2409=head2 $class->prepare( @arguments )
fbcc39ad 2410
ae1e6b59 2411Creates a Catalyst context from an engine-specific request (Apache, CGI,
2412etc.).
fbcc39ad 2413
2414=cut
2415
398f13db 2416has _uploadtmp => (
2417 is => 'ro',
2418 predicate => '_has_uploadtmp',
2419);
2420
fbcc39ad 2421sub prepare {
2422 my ( $class, @arguments ) = @_;
2423
6680c772 2424 # XXX
2425 # After the app/ctxt split, this should become an attribute based on something passed
2426 # into the application.
3cec521a 2427 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2428
398f13db 2429 my $uploadtmp = $class->config->{uploadtmp};
2430 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2431
258733f1 2432 $c->response->_context($c);
395037a2 2433 $c->stats($class->stats_class->new)->enable($c->use_stats);
ec4d7259 2434
4f0b7cf1 2435 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2436 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2437 }
2438
3640641e 2439 try {
2440 # Allow engine to direct the prepare flow (for POE)
2441 if ( my $prepare = $c->engine->can('prepare') ) {
2442 $c->engine->$prepare( $c, @arguments );
2443 }
2444 else {
2445 $c->prepare_request(@arguments);
2446 $c->prepare_connection;
2447 $c->prepare_query_parameters;
41aaa5d6 2448 $c->prepare_headers; # Just hooks, no longer needed - they just
2449 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2450 $c->prepare_path;
2451
2452 # Prepare the body for reading, either by prepare_body
2453 # or the user, if they are using $c->read
2454 $c->prepare_read;
2455
2456 # Parse the body unless the user wants it on-demand
2457 unless ( ref($c)->config->{parse_on_demand} ) {
2458 $c->prepare_body;
2459 }
878b821c 2460 }
676bed72 2461 $c->prepare_action;
5050d7a7 2462 }
3640641e 2463 # VERY ugly and probably shouldn't rely on ->finalize actually working
2464 catch {
2465 # failed prepare is always due to an invalid request, right?
5e25c01f 2466 # Note we call finalize and then die here, which escapes
2467 # finalize being called in the enclosing block..
2468 # It in fact couldn't be called, as we don't return $c..
2469 # This is a mess - but I'm unsure you can fix this without
2470 # breaking compat for people doing crazy things (we should set
2471 # the 400 and just return the ctx here IMO, letting finalize get called
2472 # above...
058e4074 2473 if ( $c->_handle_http_exception($_) ) {
2474 foreach my $err (@{$c->error}) {
2475 $c->log->error($err);
2476 }
2477 $c->clear_errors;
2478 $c->log->_flush if $c->log->can('_flush');
2479 $_->can('rethrow') ? $_->rethrow : croak $_;
2480 } else {
2481 $c->response->status(400);
2482 $c->response->content_type('text/plain');
2483 $c->response->body('Bad Request');
2484 $c->finalize;
2485 die $_;
2486 }
3640641e 2487 };
fbcc39ad 2488
10f204e1 2489 $c->log_request;
be57189a 2490 $c->{stash} = $c->stash;
d86c0bd4 2491 Scalar::Util::weaken($c->{stash});
fbcc39ad 2492
2493 return $c;
2494}
2495
b5ecfcf0 2496=head2 $c->prepare_action
fbcc39ad 2497
b4b01a8a 2498Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2499
2500=cut
2501
9c38cb50 2502sub prepare_action {
2503 my $c = shift;
2504 my $ret = $c->dispatcher->prepare_action( $c, @_);
2505
2506 if($c->encoding) {
2507 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2508 $_ = $c->_handle_param_unicode_decoding($_);
2509 }
2510 }
2511
2512 return $ret;
2513}
2514
fbcc39ad 2515
b5ecfcf0 2516=head2 $c->prepare_body
fbcc39ad 2517
e7f1cf73 2518Prepares message body.
fbcc39ad 2519
2520=cut
2521
2522sub prepare_body {
2523 my $c = shift;
2524
0f56bbcf 2525 return if $c->request->_has_body;
fbcc39ad 2526
2527 # Initialize on-demand data
2528 $c->engine->prepare_body( $c, @_ );
2529 $c->prepare_parameters;
2530 $c->prepare_uploads;
fbcc39ad 2531}
2532
b5ecfcf0 2533=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2534
e7f1cf73 2535Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2536
b4b01a8a 2537See L<Catalyst::Engine>.
2538
4bd82c41 2539=cut
2540
4f5ebacd 2541sub prepare_body_chunk {
2542 my $c = shift;
4bd82c41 2543 $c->engine->prepare_body_chunk( $c, @_ );
2544}
2545
b5ecfcf0 2546=head2 $c->prepare_body_parameters
fbcc39ad 2547
e7f1cf73 2548Prepares body parameters.
fbcc39ad 2549
2550=cut
2551
2552sub prepare_body_parameters {
2553 my $c = shift;
b9d96e27 2554 $c->request->prepare_body_parameters( $c, @_ );
fbcc39ad 2555}
2556
b5ecfcf0 2557=head2 $c->prepare_connection
fbcc39ad 2558
e7f1cf73 2559Prepares connection.
fbcc39ad 2560
2561=cut
2562
2563sub prepare_connection {
2564 my $c = shift;
817ed8ab 2565 $c->request->prepare_connection($c);
fbcc39ad 2566}
2567
b5ecfcf0 2568=head2 $c->prepare_cookies
fbcc39ad 2569
41aaa5d6 2570Prepares cookies by ensuring that the attribute on the request
2571object has been built.
fbcc39ad 2572
2573=cut
2574
41aaa5d6 2575sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2576
b5ecfcf0 2577=head2 $c->prepare_headers
fbcc39ad 2578
41aaa5d6 2579Prepares request headers by ensuring that the attribute on the request
2580object has been built.
fbcc39ad 2581
2582=cut
2583
41aaa5d6 2584sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2585
b5ecfcf0 2586=head2 $c->prepare_parameters
fbcc39ad 2587
e7f1cf73 2588Prepares parameters.
fbcc39ad 2589
2590=cut
2591
2592sub prepare_parameters {
2593 my $c = shift;
2594 $c->prepare_body_parameters;
2595 $c->engine->prepare_parameters( $c, @_ );
2596}
2597
b5ecfcf0 2598=head2 $c->prepare_path
fbcc39ad 2599
e7f1cf73 2600Prepares path and base.
fbcc39ad 2601
2602=cut
2603
2604sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2605
b5ecfcf0 2606=head2 $c->prepare_query_parameters
fbcc39ad 2607
e7f1cf73 2608Prepares query parameters.
fbcc39ad 2609
2610=cut
2611
2612sub prepare_query_parameters {
2613 my $c = shift;
2614
2615 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2616}
fbcc39ad 2617
10f204e1 2618=head2 $c->log_request
2619
2620Writes information about the request to the debug logs. This includes:
2621
2622=over 4
2623
854e5dcd 2624=item * Request method, path, and remote IP address
10f204e1 2625
2626=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2627
e7cbe1bf 2628=item * Request parameters
10f204e1 2629
2630=item * File uploads
2631
2632=back
fbcc39ad 2633
2634=cut
2635
10f204e1 2636sub log_request {
2637 my $c = shift;
fbcc39ad 2638
10f204e1 2639 return unless $c->debug;
fbcc39ad 2640
2bf54936 2641 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2642 my $request = $dump->[1];
e7cbe1bf 2643
2644 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2645 $method ||= '';
2646 $path = '/' unless length $path;
2647 $address ||= '';
0ca510f0 2648
2649 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
2650 $path = decode_utf8($path);
2651
10f204e1 2652 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2653
3a4abdb3 2654 $c->log_request_headers($request->headers);
e7cbe1bf 2655
2656 if ( my $keywords = $request->query_keywords ) {
10f204e1 2657 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2658 }
10f204e1 2659
9c74923d 2660 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2661
e7cbe1bf 2662 $c->log_request_uploads($request);
fbcc39ad 2663}
2664
10f204e1 2665=head2 $c->log_response
fbcc39ad 2666
75b65816 2667Writes information about the response to the debug logs by calling
2668C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2669
2670=cut
2671
75b65816 2672sub log_response {
2673 my $c = shift;
fbcc39ad 2674
75b65816 2675 return unless $c->debug;
fbcc39ad 2676
75b65816 2677 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2678 my $response = $dump->[1];
2679
2680 $c->log_response_status_line($response);
2681 $c->log_response_headers($response->headers);
2682}
2683
2684=head2 $c->log_response_status_line($response)
2685
2686Writes one line of information about the response to the debug logs. This includes:
10f204e1 2687
2688=over 4
2689
2690=item * Response status code
2691
3a4abdb3 2692=item * Content-Type header (if present)
2693
2694=item * Content-Length header (if present)
10f204e1 2695
2696=back
fbcc39ad 2697
2698=cut
2699
75b65816 2700sub log_response_status_line {
2701 my ($c, $response) = @_;
fbcc39ad 2702
697bab77 2703 $c->log->debug(
2704 sprintf(
2705 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2706 $response->status || 'unknown',
2707 $response->headers->header('Content-Type') || 'unknown',
2708 $response->headers->header('Content-Length') || 'unknown'
2709 )
2710 );
10f204e1 2711}
fbcc39ad 2712
75b65816 2713=head2 $c->log_response_headers($headers);
2714
8ad6fd58 2715Hook method which can be wrapped by plugins to log the response headers.
75b65816 2716No-op in the default implementation.
fbcc39ad 2717
2718=cut
2719
75b65816 2720sub log_response_headers {}
fbcc39ad 2721
10f204e1 2722=head2 $c->log_request_parameters( query => {}, body => {} )
2723
2724Logs request parameters to debug logs
2725
10f204e1 2726=cut
2727
2728sub log_request_parameters {
2729 my $c = shift;
2730 my %all_params = @_;
2731
2bf54936 2732 return unless $c->debug;
e7cbe1bf 2733
10f204e1 2734 my $column_width = Catalyst::Utils::term_width() - 44;
2735 foreach my $type (qw(query body)) {
2bf54936 2736 my $params = $all_params{$type};
2737 next if ! keys %$params;
10f204e1 2738 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2739 for my $key ( sort keys %$params ) {
22e42310 2740 my @values = ();
2741 if(ref $params eq 'Hash::MultiValue') {
2742 @values = $params->get_all($key);
2743 } else {
2744 my $param = $params->{$key};
2745 if( defined($param) ) {
2746 @values = ref $param eq 'ARRAY' ? @$param : $param;
2747 }
2748 }
2749 $t->row( $key.( scalar @values > 1 ? ' [multiple]' : ''), join(', ', @values) );
10f204e1 2750 }
2751 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2752 }
2753}
2754
2755=head2 $c->log_request_uploads
2756
2757Logs file uploads included in the request to the debug logs.
854e5dcd 2758The parameter name, filename, file type, and file size are all included in
10f204e1 2759the debug logs.
2760
2761=cut
fbcc39ad 2762
10f204e1 2763sub log_request_uploads {