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