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