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