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