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