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