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