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