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