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