fix some minor Pod formating errors
[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
707988f8 123our $VERSION = '5.90051';
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_log( delete $flags->{log} );
1128 $class->setup_plugins( delete $flags->{plugins} );
10e39267 1129 $class->setup_middleware();
b87d834e 1130 $class->setup_data_handlers();
fbcc39ad 1131 $class->setup_dispatcher( delete $flags->{dispatcher} );
acbecf08 1132 if (my $engine = delete $flags->{engine}) {
0aafa77a 1133 $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
acbecf08 1134 }
1135 $class->setup_engine();
dc5f035e 1136 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1137
1138 for my $flag ( sort keys %{$flags} ) {
1139
1140 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1141 &$code( $class, delete $flags->{$flag} );
1142 }
1143 else {
1144 $class->log->warn(qq/Unknown flag "$flag"/);
1145 }
1146 }
1147
0eb4af72 1148 eval { require Catalyst::Devel; };
1149 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1150 $class->log->warn(<<"EOF");
4ff0d824 1151You are running an old script!
1152
34a83d89 1153 Please update by running (this will overwrite existing files):
1154 catalyst.pl -force -scripts $class
1155
1156 or (this will not overwrite existing files):
1157 catalyst.pl -scripts $class
1cf0345b 1158
4ff0d824 1159EOF
0eb4af72 1160 }
62a6df80 1161
fbcc39ad 1162 if ( $class->debug ) {
6601f2ad 1163 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1164
1165 if (@plugins) {
39fc2ce1 1166 my $column_width = Catalyst::Utils::term_width() - 6;
1167 my $t = Text::SimpleTable->new($column_width);
8c113188 1168 $t->row($_) for @plugins;
1cf0345b 1169 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1170 }
1171
ba0b0de3 1172 my @middleware = map {
1173 ref $_ eq 'CODE' ?
1174 "Inline Coderef" :
ef5ad930 1175 (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
ba0b0de3 1176 || '') } $class->registered_middlewares;
10e39267 1177
1178 if (@middleware) {
1179 my $column_width = Catalyst::Utils::term_width() - 6;
1180 my $t = Text::SimpleTable->new($column_width);
1181 $t->row($_) for @middleware;
1182 $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1183 }
1184
ef5ad930 1185 my %dh = $class->registered_data_handlers;
1186 if (my @data_handlers = keys %dh) {
b87d834e 1187 my $column_width = Catalyst::Utils::term_width() - 6;
1188 my $t = Text::SimpleTable->new($column_width);
1189 $t->row($_) for @data_handlers;
1190 $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1191 }
1192
fbcc39ad 1193 my $dispatcher = $class->dispatcher;
1194 my $engine = $class->engine;
1195 my $home = $class->config->{home};
1196
01ce7075 1197 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1198 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1199
1200 $home
1201 ? ( -d $home )
1202 ? $class->log->debug(qq/Found home "$home"/)
1203 : $class->log->debug(qq/Home "$home" doesn't exist/)
1204 : $class->log->debug(q/Couldn't find home/);
1205 }
1206
54f4bfef 1207 # Call plugins setup, this is stupid and evil.
16b7c476 1208 # Also screws C3 badly on 5.10, hack to avoid.
fbcc39ad 1209 {
1210 no warnings qw/redefine/;
1211 local *setup = sub { };
16b7c476 1212 $class->setup unless $Catalyst::__AM_RESTARTING;
fbcc39ad 1213 }
1214
1215 # Initialize our data structure
1216 $class->components( {} );
1217
1218 $class->setup_components;
1219
1220 if ( $class->debug ) {
39fc2ce1 1221 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1222 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1223 for my $comp ( sort keys %{ $class->components } ) {
1224 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1225 $t->row( $comp, $type );
1226 }
1cf0345b 1227 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1228 if ( keys %{ $class->components } );
fbcc39ad 1229 }
1230
1231 # Add our self to components, since we are also a component
96d8d513 1232 if( $class->isa('Catalyst::Controller') ){
1233 $class->components->{$class} = $class;
1234 }
fbcc39ad 1235
1236 $class->setup_actions;
1237
1238 if ( $class->debug ) {
1239 my $name = $class->config->{name} || 'Application';
1240 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1241 }
3643e890 1242
647a3de1 1243 if ($class->config->{case_sensitive}) {
1244 $class->log->warn($class . "->config->{case_sensitive} is set.");
1245 $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1246 }
1247
a5d07d29 1248 $class->setup_finalize;
647a3de1 1249 # Should be the last thing we do so that user things hooking
1250 # setup_finalize can log..
1251 $class->log->_flush() if $class->log->can('_flush');
64ceb36b 1252 return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
a5d07d29 1253}
1254
23c63a17 1255=head2 $app->setup_finalize
1256
128a7cee 1257A hook to attach modifiers to. This method does not do anything except set the
1258C<setup_finished> accessor.
23c63a17 1259
ae7da8f5 1260Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
23c63a17 1261
128a7cee 1262Example:
23c63a17 1263
128a7cee 1264 after setup_finalize => sub {
1265 my $app = shift;
23c63a17 1266
128a7cee 1267 ## do stuff here..
1268 };
23c63a17 1269
1270=cut
1271
a5d07d29 1272sub setup_finalize {
1273 my ($class) = @_;
3643e890 1274 $class->setup_finished(1);
fbcc39ad 1275}
1276
d71da6fe 1277=head2 $c->uri_for( $path?, @args?, \%query_values? )
fbcc39ad 1278
ee8963de 1279=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
9df7c5d9 1280
ee8963de 1281Constructs an absolute L<URI> object based on the application root, the
1282provided path, and the additional arguments and query parameters provided.
186d5270 1283When used as a string, provides a textual URI. If you need more flexibility
92981fc3 1284than this (i.e. the option to provide relative URIs etc.) see
186d5270 1285L<Catalyst::Plugin::SmartURI>.
ee8963de 1286
d71da6fe 1287If no arguments are provided, the URI for the current action is returned.
1288To return the current action and also provide @args, use
1d3a0700 1289C<< $c->uri_for( $c->action, @args ) >>.
d71da6fe 1290
ee8963de 1291If the first argument is a string, it is taken as a public URI path relative
1292to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
e7e4c469 1293relative to the application root (if it does). It is then merged with
ee8963de 1294C<< $c->request->base >>; any C<@args> are appended as additional path
1295components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1296
1297If the first argument is a L<Catalyst::Action> it represents an action which
1298will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1299optional C<\@captures> argument (an arrayref) allows passing the captured
1300variables that are needed to fill in the paths of Chained and Regex actions;
1301once the path is resolved, C<uri_for> continues as though a path was
1302provided, appending any arguments or parameters and creating an absolute
1303URI.
1304
e7e4c469 1305The captures for the current request can be found in
ee8963de 1306C<< $c->request->captures >>, and actions can be resolved using
1307C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1308path, use C<< $c->uri_for_action >> instead.
1309
1310 # Equivalent to $c->req->uri
e7e4c469 1311 $c->uri_for($c->action, $c->req->captures,
ee8963de 1312 @{ $c->req->args }, $c->req->params);
62a6df80 1313
9df7c5d9 1314 # For the Foo action in the Bar controller
ee8963de 1315 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1316
ee8963de 1317 # Path to a static resource
1318 $c->uri_for('/static/images/logo.png');
d5e3d528 1319
4cf1dd00 1320=cut
1321
fbcc39ad 1322sub uri_for {
00e6a2b7 1323 my ( $c, $path, @args ) = @_;
00e6a2b7 1324
0ee04045 1325 if ( $path->$_isa('Catalyst::Controller') ) {
7069eab5 1326 $path = $path->path_prefix;
1327 $path =~ s{/+\z}{};
1328 $path .= '/';
1329 }
1330
2689f8a4 1331 undef($path) if (defined $path && $path eq '');
1332
1333 my $params =
1334 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1335
1336 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
a4f2cdc8 1337 foreach my $arg (@args) {
1338 utf8::encode($arg) if utf8::is_utf8($arg);
49229f68 1339 $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
2689f8a4 1340 }
1341
0ee04045 1342 if ( $path->$_isa('Catalyst::Action') ) { # action object
49229f68 1343 s|/|%2F|g for @args;
2689f8a4 1344 my $captures = [ map { s|/|%2F|g; $_; }
aaf72276 1345 ( scalar @args && ref $args[0] eq 'ARRAY'
1346 ? @{ shift(@args) }
1347 : ()) ];
7b346bc3 1348
1349 foreach my $capture (@$captures) {
1350 utf8::encode($capture) if utf8::is_utf8($capture);
1351 $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1352 }
1353
aa7e913e 1354 my $action = $path;
0cff119a 1355 # ->uri_for( $action, \@captures_and_args, \%query_values? )
1356 if( !@args && $action->number_of_args ) {
1357 my $expanded_action = $c->dispatcher->expand_action( $action );
1358
1359 my $num_captures = $expanded_action->number_of_captures;
1360 unshift @args, splice @$captures, $num_captures;
1361 }
1362
1363 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1364 if (not defined $path) {
1365 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1366 if $c->debug;
1367 return undef;
1368 }
81e75875 1369 $path = '/' if $path eq '';
ea0e58d9 1370 }
1371
51674a63 1372 unshift(@args, $path);
1373
1374 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1375 my $namespace = $c->namespace;
1376 if (defined $path) { # cheesy hack to handle path '../foo'
1377 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1378 }
51674a63 1379 unshift(@args, $namespace || '');
1380 }
62a6df80 1381
189e2a51 1382 # join args with '/', or a blank string
51674a63 1383 my $args = join('/', grep { defined($_) } @args);
1384 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1385 $args =~ s!^/+!!;
f9451270 1386
1387 my ($base, $class) = ('/', 'URI::_generic');
1388 if(blessed($c)) {
1389 $base = $c->req->base;
1390 $class = ref($base);
1391 $base =~ s{(?<!/)$}{/};
1392 }
51674a63 1393
1394 my $query = '';
1395
1396 if (my @keys = keys %$params) {
1397 # somewhat lifted from URI::_query's query_form
1398 $query = '?'.join('&', map {
2f381252 1399 my $val = $params->{$_};
51674a63 1400 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1401 s/ /+/g;
1402 my $key = $_;
51674a63 1403 $val = '' unless defined $val;
1404 (map {
1f851263 1405 my $param = "$_";
1406 utf8::encode( $param ) if utf8::is_utf8($param);
51674a63 1407 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1408 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1409 $param =~ s/ /+/g;
1410 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1411 } @keys);
1412 }
1413
1414 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1415 $res;
fbcc39ad 1416}
1417
25d61080 1418=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1419
25d61080 1420=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1421
1422=over
1423
1424=item $path
1425
1426A private path to the Catalyst action you want to create a URI for.
1427
1428This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1429>> and passing the resulting C<$action> and the remaining arguments to C<<
1430$c->uri_for >>.
1431
1432You can also pass in a Catalyst::Action object, in which case it is passed to
1433C<< $c->uri_for >>.
1434
c9ec25f8 1435Note 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.
1436
1437For example, if the action looks like:
1438
1439 package MyApp::Controller::Users;
1440
1441 sub lst : Path('the-list') {}
1442
1443You can use:
1444
1445 $c->uri_for_action('/users/lst')
1446
1447and it will create the URI /users/the-list.
1448
25d61080 1449=item \@captures_and_args?
1450
1451Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1452and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1453to interpolate all the parameters in the URI.
1454
1455=item @args?
1456
942572d7 1457Optional list of extra arguments - can be supplied in the
1458C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1459code.
25d61080 1460
942572d7 1461Your action can have zero, a fixed or a variable number of args (e.g.
1462C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1463
1464=item \%query_values?
1465
1466Optional array reference of query parameters to append. E.g.
1467
1468 { foo => 'bar' }
1469
1470will generate
1471
1472 /rest/of/your/uri?foo=bar
1473
833b385e 1474=back
1475
1476=cut
1477
1478sub uri_for_action {
1479 my ( $c, $path, @args ) = @_;
62a6df80 1480 my $action = blessed($path)
1481 ? $path
833b385e 1482 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1483 unless (defined $action) {
1484 croak "Can't find action for path '$path'";
1485 }
833b385e 1486 return $c->uri_for( $action, @args );
1487}
1488
b5ecfcf0 1489=head2 $c->welcome_message
ab2374d3 1490
1491Returns the Catalyst welcome HTML page.
1492
1493=cut
1494
1495sub welcome_message {
bf1f2c60 1496 my $c = shift;
1497 my $name = $c->config->{name};
1498 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1499 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1500 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1501 return <<"EOF";
80cdbbff 1502<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1503 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1504<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1505 <head>
85d9fce6 1506 <meta http-equiv="Content-Language" content="en" />
1507 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1508 <title>$name on Catalyst $VERSION</title>
1509 <style type="text/css">
1510 body {
ab2374d3 1511 color: #000;
1512 background-color: #eee;
1513 }
1514 div#content {
1515 width: 640px;
80cdbbff 1516 margin-left: auto;
1517 margin-right: auto;
ab2374d3 1518 margin-top: 10px;
1519 margin-bottom: 10px;
1520 text-align: left;
1521 background-color: #ccc;
1522 border: 1px solid #aaa;
ab2374d3 1523 }
d84c4dab 1524 p, h1, h2 {
ab2374d3 1525 margin-left: 20px;
1526 margin-right: 20px;
16215972 1527 font-family: verdana, tahoma, sans-serif;
ab2374d3 1528 }
d84c4dab 1529 a {
1530 font-family: verdana, tahoma, sans-serif;
1531 }
d114e033 1532 :link, :visited {
1533 text-decoration: none;
1534 color: #b00;
1535 border-bottom: 1px dotted #bbb;
1536 }
1537 :link:hover, :visited:hover {
d114e033 1538 color: #555;
1539 }
ab2374d3 1540 div#topbar {
1541 margin: 0px;
1542 }
3e82a295 1543 pre {
3e82a295 1544 margin: 10px;
1545 padding: 8px;
1546 }
ab2374d3 1547 div#answers {
1548 padding: 8px;
1549 margin: 10px;
d114e033 1550 background-color: #fff;
ab2374d3 1551 border: 1px solid #aaa;
ab2374d3 1552 }
1553 h1 {
33108eaf 1554 font-size: 0.9em;
1555 font-weight: normal;
ab2374d3 1556 text-align: center;
1557 }
1558 h2 {
1559 font-size: 1.0em;
1560 }
1561 p {
1562 font-size: 0.9em;
1563 }
ae7c5252 1564 p img {
1565 float: right;
1566 margin-left: 10px;
1567 }
9619f23c 1568 span#appname {
1569 font-weight: bold;
33108eaf 1570 font-size: 1.6em;
ab2374d3 1571 }
1572 </style>
1573 </head>
1574 <body>
1575 <div id="content">
1576 <div id="topbar">
9619f23c 1577 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1578 $VERSION</h1>
ab2374d3 1579 </div>
1580 <div id="answers">
ae7c5252 1581 <p>
80cdbbff 1582 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1583 </p>
596aaffe 1584 <p>Welcome to the world of Catalyst.
f92fd545 1585 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1586 framework will make web development something you had
60dd6e1d 1587 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1588 <h2>What to do now?</h2>
4b8cb778 1589 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1590 We do, however, provide you with a few starting points.</p>
1591 <p>If you want to jump right into web development with Catalyst
2f381252 1592 you might want to start with a tutorial.</p>
80267996 1593<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1594</pre>
1595<p>Afterwards you can go on to check out a more complete look at our features.</p>
1596<pre>
80267996 1597<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1598<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1599</code></pre>
ab2374d3 1600 <h2>What to do next?</h2>
f5681c92 1601 <p>Next it's time to write an actual application. Use the
80267996 1602 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1603 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1604 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1605 they can save you a lot of work.</p>
c5f31918 1606 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1607 <p>Also, be sure to check out the vast and growing
802bf2cb 1608 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1609 you are likely to find what you need there.
f5681c92 1610 </p>
1611
82245cc4 1612 <h2>Need help?</h2>
f5681c92 1613 <p>Catalyst has a very active community. Here are the main places to
1614 get in touch with us.</p>
16215972 1615 <ul>
1616 <li>
2b9a7d76 1617 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1618 </li>
1619 <li>
6d4c3368 1620 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1621 </li>
1622 <li>
4eaf7c88 1623 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1624 </li>
1625 </ul>
ab2374d3 1626 <h2>In conclusion</h2>
62a6df80 1627 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1628 as we enjoyed making it. Please contact us if you have ideas
1629 for improvement or other feedback.</p>
ab2374d3 1630 </div>
1631 </div>
1632 </body>
1633</html>
1634EOF
1635}
1636
aee7cdcc 1637=head2 run_options
1638
1639Contains a hash of options passed from the application script, including
c2c8d3cb 1640the original ARGV the script received, the processed values from that
aee7cdcc 1641ARGV and any extra arguments to the script which were not processed.
1642
1643This can be used to add custom options to your application's scripts
1644and setup your application differently depending on the values of these
1645options.
1646
fbcc39ad 1647=head1 INTERNAL METHODS
1648
ae1e6b59 1649These methods are not meant to be used by end users.
1650
b5ecfcf0 1651=head2 $c->components
fbcc39ad 1652
e7f1cf73 1653Returns a hash of components.
fbcc39ad 1654
b5ecfcf0 1655=head2 $c->context_class
1f9cb7c1 1656
e7f1cf73 1657Returns or sets the context class.
1f9cb7c1 1658
b5ecfcf0 1659=head2 $c->counter
fbcc39ad 1660
ae1e6b59 1661Returns a hashref containing coderefs and execution counts (needed for
1662deep recursion detection).
fbcc39ad 1663
b5ecfcf0 1664=head2 $c->depth
fbcc39ad 1665
e7f1cf73 1666Returns the number of actions on the current internal execution stack.
fbcc39ad 1667
b5ecfcf0 1668=head2 $c->dispatch
fbcc39ad 1669
e7f1cf73 1670Dispatches a request to actions.
fbcc39ad 1671
1672=cut
1673
1674sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1675
b5ecfcf0 1676=head2 $c->dispatcher_class
1f9cb7c1 1677
e7f1cf73 1678Returns or sets the dispatcher class.
1f9cb7c1 1679
b5ecfcf0 1680=head2 $c->dump_these
7f92deef 1681
ae1e6b59 1682Returns a list of 2-element array references (name, structure) pairs
1683that will be dumped on the error page in debug mode.
7f92deef 1684
1685=cut
1686
1687sub dump_these {
1688 my $c = shift;
62a6df80 1689 [ Request => $c->req ],
1690 [ Response => $c->res ],
052a2d89 1691 [ Stash => $c->stash ],
1692 [ Config => $c->config ];
7f92deef 1693}
1694
b5ecfcf0 1695=head2 $c->engine_class
1f9cb7c1 1696
e7f1cf73 1697Returns or sets the engine class.
1f9cb7c1 1698
b5ecfcf0 1699=head2 $c->execute( $class, $coderef )
fbcc39ad 1700
0ef52a96 1701Execute a coderef in given class and catch exceptions. Errors are available
1702via $c->error.
fbcc39ad 1703
1704=cut
1705
1706sub execute {
1707 my ( $c, $class, $code ) = @_;
858828dd 1708 $class = $c->component($class) || $class;
fbcc39ad 1709 $c->state(0);
a0eca838 1710
197bd788 1711 if ( $c->depth >= $RECURSION ) {
f3414019 1712 my $action = $code->reverse();
91d08727 1713 $action = "/$action" unless $action =~ /->/;
f3414019 1714 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1715 $c->log->error($error);
1716 $c->error($error);
1717 $c->state(0);
1718 return $c->state;
1719 }
1720
dc5f035e 1721 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1722
8767c5a3 1723 push( @{ $c->stack }, $code );
62a6df80 1724
6f3df815 1725 no warnings 'recursion';
524b0e1c 1726 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1727 # I have no idea how, ergo $ret (which appears to fix the issue)
1728 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 1729
dc5f035e 1730 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1731
a6724a82 1732 my $last = pop( @{ $c->stack } );
fbcc39ad 1733
1734 if ( my $error = $@ ) {
79f5d571 1735 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 1736 $error->rethrow if $c->depth > 1;
2f381252 1737 }
79f5d571 1738 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 1739 $error->rethrow if $c->depth > 0;
55424863 1740 }
fbcc39ad 1741 else {
1742 unless ( ref $error ) {
91d08727 1743 no warnings 'uninitialized';
fbcc39ad 1744 chomp $error;
f59def82 1745 my $class = $last->class;
1746 my $name = $last->name;
1747 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1748 }
fbcc39ad 1749 $c->error($error);
fbcc39ad 1750 }
2688734f 1751 $c->state(0);
fbcc39ad 1752 }
1753 return $c->state;
1754}
1755
7a7d7af5 1756sub _stats_start_execute {
1757 my ( $c, $code ) = @_;
df960201 1758 my $appclass = ref($c) || $c;
a6724a82 1759 return if ( ( $code->name =~ /^_.*/ )
df960201 1760 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 1761
f3414019 1762 my $action_name = $code->reverse();
1763 $c->counter->{$action_name}++;
7a7d7af5 1764
f3414019 1765 my $action = $action_name;
a6724a82 1766 $action = "/$action" unless $action =~ /->/;
1767
7a7d7af5 1768 # determine if the call was the result of a forward
1769 # this is done by walking up the call stack and looking for a calling
1770 # sub of Catalyst::forward before the eval
1771 my $callsub = q{};
1772 for my $index ( 2 .. 11 ) {
1773 last
1774 if ( ( caller($index) )[0] eq 'Catalyst'
1775 && ( caller($index) )[3] eq '(eval)' );
1776
1777 if ( ( caller($index) )[3] =~ /forward$/ ) {
1778 $callsub = ( caller($index) )[3];
1779 $action = "-> $action";
1780 last;
1781 }
1782 }
1783
f3414019 1784 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1785
a6724a82 1786 # is this a root-level call or a forwarded call?
1787 if ( $callsub =~ /forward$/ ) {
91740f34 1788 my $parent = $c->stack->[-1];
a6724a82 1789
1790 # forward, locate the caller
9c74923d 1791 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 1792 $c->stats->profile(
62a6df80 1793 begin => $action,
69d8f33c 1794 parent => "$parent" . $c->counter->{"$parent"},
1795 uid => $uid,
1796 );
7a7d7af5 1797 }
1798 else {
1799
a6724a82 1800 # forward with no caller may come from a plugin
69d8f33c 1801 $c->stats->profile(
1802 begin => $action,
1803 uid => $uid,
1804 );
7a7d7af5 1805 }
1806 }
a6724a82 1807 else {
62a6df80 1808
a6724a82 1809 # root-level call
69d8f33c 1810 $c->stats->profile(
1811 begin => $action,
1812 uid => $uid,
1813 );
a6724a82 1814 }
dc5f035e 1815 return $action;
7a7d7af5 1816
7a7d7af5 1817}
1818
1819sub _stats_finish_execute {
1820 my ( $c, $info ) = @_;
69d8f33c 1821 $c->stats->profile( end => $info );
7a7d7af5 1822}
1823
b5ecfcf0 1824=head2 $c->finalize
fbcc39ad 1825
e7f1cf73 1826Finalizes the request.
fbcc39ad 1827
1828=cut
1829
1830sub finalize {
1831 my $c = shift;
1832
369c09bc 1833 for my $error ( @{ $c->error } ) {
1834 $c->log->error($error);
1835 }
1836
eb1f4b49 1837 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
1838 # stuff like cometd and websockets
1839
c2fef52f 1840 if($c->request->_has_io_fh) {
74bebe95 1841 $c->log_response;
1842 return;
1843 }
eb1f4b49 1844
5050d7a7 1845 # Allow engine to handle finalize flow (for POE)
e63bdf38 1846 my $engine = $c->engine;
1847 if ( my $code = $engine->can('finalize') ) {
1848 $engine->$code($c);
fbcc39ad 1849 }
5050d7a7 1850 else {
fbcc39ad 1851
5050d7a7 1852 $c->finalize_uploads;
fbcc39ad 1853
5050d7a7 1854 # Error
1855 if ( $#{ $c->error } >= 0 ) {
1856 $c->finalize_error;
1857 }
1858
89ba65d5 1859 $c->finalize_headers unless $c->response->finalized_headers;
fbcc39ad 1860
5050d7a7 1861 # HEAD request
1862 if ( $c->request->method eq 'HEAD' ) {
1863 $c->response->body('');
1864 }
1865
1866 $c->finalize_body;
1867 }
62a6df80 1868
2bf54936 1869 $c->log_response;
10f204e1 1870
62a6df80 1871 if ($c->use_stats) {
87b41398 1872 my $elapsed = $c->stats->elapsed;
12bf12c0 1873 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1874 $c->log->info(
62a6df80 1875 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1876 }
fbcc39ad 1877
1878 return $c->response->status;
1879}
1880
b5ecfcf0 1881=head2 $c->finalize_body
fbcc39ad 1882
e7f1cf73 1883Finalizes body.
fbcc39ad 1884
1885=cut
1886
1887sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1888
b5ecfcf0 1889=head2 $c->finalize_cookies
fbcc39ad 1890
e7f1cf73 1891Finalizes cookies.
fbcc39ad 1892
1893=cut
1894
147821ea 1895sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1896
b5ecfcf0 1897=head2 $c->finalize_error
fbcc39ad 1898
e7f1cf73 1899Finalizes error.
fbcc39ad 1900
1901=cut
1902
1903sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1904
b5ecfcf0 1905=head2 $c->finalize_headers
fbcc39ad 1906
e7f1cf73 1907Finalizes headers.
fbcc39ad 1908
1909=cut
1910
1911sub finalize_headers {
1912 my $c = shift;
1913
e63bdf38 1914 my $response = $c->response; #accessor calls can add up?
1915
fbcc39ad 1916 # Check if we already finalized headers
6680c772 1917 return if $response->finalized_headers;
fbcc39ad 1918
1919 # Handle redirects
e63bdf38 1920 if ( my $location = $response->redirect ) {
fbcc39ad 1921 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1922 $response->header( Location => $location );
a7caa492 1923
02570318 1924 if ( !$response->has_body ) {
39655cdc 1925 # Add a default body if none is already present
7af54927 1926 my $encoded_location = encode_entities($location);
9c331634 1927 $response->body(<<"EOF");
1928<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
1929<html xmlns="http://www.w3.org/1999/xhtml">
1930 <head>
1931 <title>Moved</title>
1932 </head>
1933 <body>
7af54927 1934 <p>This item has moved <a href="$encoded_location">here</a>.</p>
9c331634 1935 </body>
1936</html>
1937EOF
d455230c 1938 $response->content_type('text/html; charset=utf-8');
39655cdc 1939 }
fbcc39ad 1940 }
1941
1942 # Content-Length
ac057d3b 1943 if ( defined $response->body && length $response->body && !$response->content_length ) {
775878ac 1944
8f62c91a 1945 # get the length from a filehandle
9c74923d 1946 if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
197bd788 1947 {
34effbc7 1948 my $size = -s $response->body;
1949 if ( $size ) {
1950 $response->content_length( $size );
8f62c91a 1951 }
1952 else {
775878ac 1953 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1954 }
1955 }
1956 else {
b5d7a61f 1957 # everything should be bytes at this point, but just in case
5ab21903 1958 $response->content_length( length( $response->body ) );
8f62c91a 1959 }
fbcc39ad 1960 }
1961
1962 # Errors
e63bdf38 1963 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1964 $response->headers->remove_header("Content-Length");
1965 $response->body('');
fbcc39ad 1966 }
1967
1968 $c->finalize_cookies;
1969
89ba65d5 1970 $c->response->finalize_headers();
fbcc39ad 1971
1972 # Done
6680c772 1973 $response->finalized_headers(1);
fbcc39ad 1974}
1975
b5ecfcf0 1976=head2 $c->finalize_output
fbcc39ad 1977
1978An alias for finalize_body.
1979
b5ecfcf0 1980=head2 $c->finalize_read
fbcc39ad 1981
e7f1cf73 1982Finalizes the input after reading is complete.
fbcc39ad 1983
1984=cut
1985
1986sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1987
b5ecfcf0 1988=head2 $c->finalize_uploads
fbcc39ad 1989
ae1e6b59 1990Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1991
1992=cut
1993
1994sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1995
b5ecfcf0 1996=head2 $c->get_action( $action, $namespace )
fbcc39ad 1997
e7f1cf73 1998Gets an action in a given namespace.
fbcc39ad 1999
2000=cut
2001
684d10ed 2002sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2003
b5ecfcf0 2004=head2 $c->get_actions( $action, $namespace )
a9dc674c 2005
ae1e6b59 2006Gets all actions of a given name in a namespace and all parent
2007namespaces.
a9dc674c 2008
2009=cut
2010
2011sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2012
e5ce5f04 2013=head2 $app->handle_request( @arguments )
fbcc39ad 2014
e7f1cf73 2015Called to handle each HTTP request.
fbcc39ad 2016
2017=cut
2018
2019sub handle_request {
2020 my ( $class, @arguments ) = @_;
2021
2022 # Always expect worst case!
2023 my $status = -1;
3640641e 2024 try {
dea1884f 2025 if ($class->debug) {
908e3d9e 2026 my $secs = time - $START || 1;
2027 my $av = sprintf '%.3f', $COUNT / $secs;
2028 my $time = localtime time;
2029 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2030 }
908e3d9e 2031
2032 my $c = $class->prepare(@arguments);
2033 $c->dispatch;
62a6df80 2034 $status = $c->finalize;
fbcc39ad 2035 }
3640641e 2036 catch {
2037 chomp(my $error = $_);
2038 $class->log->error(qq/Caught exception in engine "$error"/);
2039 };
fbcc39ad 2040
2041 $COUNT++;
62a6df80 2042
6680c772 2043 if(my $coderef = $class->log->can('_flush')){
2044 $class->log->$coderef();
2045 }
fbcc39ad 2046 return $status;
2047}
2048
d536010b 2049=head2 $class->prepare( @arguments )
fbcc39ad 2050
ae1e6b59 2051Creates a Catalyst context from an engine-specific request (Apache, CGI,
2052etc.).
fbcc39ad 2053
2054=cut
2055
398f13db 2056has _uploadtmp => (
2057 is => 'ro',
2058 predicate => '_has_uploadtmp',
2059);
2060
fbcc39ad 2061sub prepare {
2062 my ( $class, @arguments ) = @_;
2063
6680c772 2064 # XXX
2065 # After the app/ctxt split, this should become an attribute based on something passed
2066 # into the application.
3cec521a 2067 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2068
398f13db 2069 my $uploadtmp = $class->config->{uploadtmp};
2070 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2071
258733f1 2072 $c->response->_context($c);
2073
b6d4ee6e 2074 #surely this is not the most efficient way to do things...
dc5f035e 2075 $c->stats($class->stats_class->new)->enable($c->use_stats);
4f0b7cf1 2076 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2077 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2078 }
2079
3640641e 2080 try {
2081 # Allow engine to direct the prepare flow (for POE)
2082 if ( my $prepare = $c->engine->can('prepare') ) {
2083 $c->engine->$prepare( $c, @arguments );
2084 }
2085 else {
2086 $c->prepare_request(@arguments);
2087 $c->prepare_connection;
2088 $c->prepare_query_parameters;
41aaa5d6 2089 $c->prepare_headers; # Just hooks, no longer needed - they just
2090 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2091 $c->prepare_path;
2092
2093 # Prepare the body for reading, either by prepare_body
2094 # or the user, if they are using $c->read
2095 $c->prepare_read;
2096
2097 # Parse the body unless the user wants it on-demand
2098 unless ( ref($c)->config->{parse_on_demand} ) {
2099 $c->prepare_body;
2100 }
878b821c 2101 }
676bed72 2102 $c->prepare_action;
5050d7a7 2103 }
3640641e 2104 # VERY ugly and probably shouldn't rely on ->finalize actually working
2105 catch {
2106 # failed prepare is always due to an invalid request, right?
2107 $c->response->status(400);
2108 $c->response->content_type('text/plain');
2109 $c->response->body('Bad Request');
5e25c01f 2110 # Note we call finalize and then die here, which escapes
2111 # finalize being called in the enclosing block..
2112 # It in fact couldn't be called, as we don't return $c..
2113 # This is a mess - but I'm unsure you can fix this without
2114 # breaking compat for people doing crazy things (we should set
2115 # the 400 and just return the ctx here IMO, letting finalize get called
2116 # above...
3640641e 2117 $c->finalize;
2118 die $_;
2119 };
fbcc39ad 2120
10f204e1 2121 $c->log_request;
fbcc39ad 2122
2123 return $c;
2124}
2125
b5ecfcf0 2126=head2 $c->prepare_action
fbcc39ad 2127
b4b01a8a 2128Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2129
2130=cut
2131
2132sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
2133
b5ecfcf0 2134=head2 $c->prepare_body
fbcc39ad 2135
e7f1cf73 2136Prepares message body.
fbcc39ad 2137
2138=cut
2139
2140sub prepare_body {
2141 my $c = shift;
2142
0f56bbcf 2143 return if $c->request->_has_body;
fbcc39ad 2144
2145 # Initialize on-demand data
2146 $c->engine->prepare_body( $c, @_ );
2147 $c->prepare_parameters;
2148 $c->prepare_uploads;
fbcc39ad 2149}
2150
b5ecfcf0 2151=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2152
e7f1cf73 2153Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2154
b4b01a8a 2155See L<Catalyst::Engine>.
2156
4bd82c41 2157=cut
2158
4f5ebacd 2159sub prepare_body_chunk {
2160 my $c = shift;
4bd82c41 2161 $c->engine->prepare_body_chunk( $c, @_ );
2162}
2163
b5ecfcf0 2164=head2 $c->prepare_body_parameters
fbcc39ad 2165
e7f1cf73 2166Prepares body parameters.
fbcc39ad 2167
2168=cut
2169
2170sub prepare_body_parameters {
2171 my $c = shift;
2172 $c->engine->prepare_body_parameters( $c, @_ );
2173}
2174
b5ecfcf0 2175=head2 $c->prepare_connection
fbcc39ad 2176
e7f1cf73 2177Prepares connection.
fbcc39ad 2178
2179=cut
2180
2181sub prepare_connection {
2182 my $c = shift;
ddcd2fc4 2183 # XXX - This is called on the engine (not the request) to maintain
2184 # Engine::PSGI back compat.
2185 $c->engine->prepare_connection($c);
fbcc39ad 2186}
2187
b5ecfcf0 2188=head2 $c->prepare_cookies
fbcc39ad 2189
41aaa5d6 2190Prepares cookies by ensuring that the attribute on the request
2191object has been built.
fbcc39ad 2192
2193=cut
2194
41aaa5d6 2195sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2196
b5ecfcf0 2197=head2 $c->prepare_headers
fbcc39ad 2198
41aaa5d6 2199Prepares request headers by ensuring that the attribute on the request
2200object has been built.
fbcc39ad 2201
2202=cut
2203
41aaa5d6 2204sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2205
b5ecfcf0 2206=head2 $c->prepare_parameters
fbcc39ad 2207
e7f1cf73 2208Prepares parameters.
fbcc39ad 2209
2210=cut
2211
2212sub prepare_parameters {
2213 my $c = shift;
2214 $c->prepare_body_parameters;
2215 $c->engine->prepare_parameters( $c, @_ );
2216}
2217
b5ecfcf0 2218=head2 $c->prepare_path
fbcc39ad 2219
e7f1cf73 2220Prepares path and base.
fbcc39ad 2221
2222=cut
2223
2224sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2225
b5ecfcf0 2226=head2 $c->prepare_query_parameters
fbcc39ad 2227
e7f1cf73 2228Prepares query parameters.
fbcc39ad 2229
2230=cut
2231
2232sub prepare_query_parameters {
2233 my $c = shift;
2234
2235 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2236}
fbcc39ad 2237
10f204e1 2238=head2 $c->log_request
2239
2240Writes information about the request to the debug logs. This includes:
2241
2242=over 4
2243
854e5dcd 2244=item * Request method, path, and remote IP address
10f204e1 2245
2246=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2247
e7cbe1bf 2248=item * Request parameters
10f204e1 2249
2250=item * File uploads
2251
2252=back
fbcc39ad 2253
2254=cut
2255
10f204e1 2256sub log_request {
2257 my $c = shift;
fbcc39ad 2258
10f204e1 2259 return unless $c->debug;
fbcc39ad 2260
2bf54936 2261 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2262 my $request = $dump->[1];
e7cbe1bf 2263
2264 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2265 $method ||= '';
2266 $path = '/' unless length $path;
2267 $address ||= '';
2268 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2269
3a4abdb3 2270 $c->log_request_headers($request->headers);
e7cbe1bf 2271
2272 if ( my $keywords = $request->query_keywords ) {
10f204e1 2273 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2274 }
10f204e1 2275
9c74923d 2276 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2277
e7cbe1bf 2278 $c->log_request_uploads($request);
fbcc39ad 2279}
2280
10f204e1 2281=head2 $c->log_response
fbcc39ad 2282
75b65816 2283Writes information about the response to the debug logs by calling
2284C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2285
2286=cut
2287
75b65816 2288sub log_response {
2289 my $c = shift;
fbcc39ad 2290
75b65816 2291 return unless $c->debug;
fbcc39ad 2292
75b65816 2293 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2294 my $response = $dump->[1];
2295
2296 $c->log_response_status_line($response);
2297 $c->log_response_headers($response->headers);
2298}
2299
2300=head2 $c->log_response_status_line($response)
2301
2302Writes one line of information about the response to the debug logs. This includes:
10f204e1 2303
2304=over 4
2305
2306=item * Response status code
2307
3a4abdb3 2308=item * Content-Type header (if present)
2309
2310=item * Content-Length header (if present)
10f204e1 2311
2312=back
fbcc39ad 2313
2314=cut
2315
75b65816 2316sub log_response_status_line {
2317 my ($c, $response) = @_;
fbcc39ad 2318
697bab77 2319 $c->log->debug(
2320 sprintf(
2321 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2322 $response->status || 'unknown',
2323 $response->headers->header('Content-Type') || 'unknown',
2324 $response->headers->header('Content-Length') || 'unknown'
2325 )
2326 );
10f204e1 2327}
fbcc39ad 2328
75b65816 2329=head2 $c->log_response_headers($headers);
2330
8ad6fd58 2331Hook method which can be wrapped by plugins to log the response headers.
75b65816 2332No-op in the default implementation.
fbcc39ad 2333
2334=cut
2335
75b65816 2336sub log_response_headers {}
fbcc39ad 2337
10f204e1 2338=head2 $c->log_request_parameters( query => {}, body => {} )
2339
2340Logs request parameters to debug logs
2341
10f204e1 2342=cut
2343
2344sub log_request_parameters {
2345 my $c = shift;
2346 my %all_params = @_;
2347
2bf54936 2348 return unless $c->debug;
e7cbe1bf 2349
10f204e1 2350 my $column_width = Catalyst::Utils::term_width() - 44;
2351 foreach my $type (qw(query body)) {
2bf54936 2352 my $params = $all_params{$type};
2353 next if ! keys %$params;
10f204e1 2354 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2355 for my $key ( sort keys %$params ) {
2356 my $param = $params->{$key};
10f204e1 2357 my $value = defined($param) ? $param : '';
2358 $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2359 }
2360 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2361 }
2362}
2363
2364=head2 $c->log_request_uploads
2365
2366Logs file uploads included in the request to the debug logs.
854e5dcd 2367The parameter name, filename, file type, and file size are all included in
10f204e1 2368the debug logs.
2369
2370=cut
fbcc39ad 2371
10f204e1 2372sub log_request_uploads {
2373 my $c = shift;
2bf54936 2374 my $request = shift;
e7cbe1bf 2375 return unless $c->debug;
2376 my $uploads = $request->uploads;
10f204e1 2377 if ( keys %$uploads ) {
8c113188 2378 my $t = Text::SimpleTable->new(
34d28dfd 2379 [ 12, 'Parameter' ],
2380 [ 26, 'Filename' ],
8c113188 2381 [ 18, 'Type' ],
2382 [ 9, 'Size' ]
2383 );
10f204e1 2384 for my $key ( sort keys %$uploads ) {
2385 my $upload = $uploads->{$key};
fbcc39ad 2386 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2387 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2388 }
2389 }
2390 $c->log->debug( "File Uploads are:\n" . $t->draw );
2391 }
2392}
2393
3a4abdb3 2394=head2 $c->log_request_headers($headers);
2395
2396Hook method which can be wrapped by plugins to log the request headers.
2397No-op in the default implementation.
2398
2399=cut
2400
2401sub log_request_headers {}
2402
10f204e1 2403=head2 $c->log_headers($type => $headers)
2404
e7cbe1bf 2405Logs L<HTTP::Headers> (either request or response) to the debug logs.
10f204e1 2406
2407=cut
2408
2409sub log_headers {
2410 my $c = shift;
2411 my $type = shift;
2412 my $headers = shift; # an HTTP::Headers instance
2413
e7cbe1bf 2414 return unless $c->debug;
10f204e1 2415
f0e9921a 2416 my $column_width = Catalyst::Utils::term_width() - 28;
2417 my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
e7cbe1bf 2418 $headers->scan(
10f204e1 2419 sub {
2420 my ( $name, $value ) = @_;
2421 $t->row( $name, $value );
2422 }
2423 );
2424 $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2425}
2426
10f204e1 2427
2428=head2 $c->prepare_read
2429
2430Prepares the input for reading.
2431
2432=cut
2433
2434sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2435
2436=head2 $c->prepare_request
2437
2438Prepares the engine request.
2439
2440=cut
2441
2442sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2443
2444=head2 $c->prepare_uploads
2445
2446Prepares uploads.
2447
2448=cut
2449
2450sub prepare_uploads {
2451 my $c = shift;
2452
2453 $c->engine->prepare_uploads( $c, @_ );
2454}
2455
b5ecfcf0 2456=head2 $c->prepare_write
fbcc39ad 2457
e7f1cf73 2458Prepares the output for writing.
fbcc39ad 2459
2460=cut
2461
2462sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2463
b5ecfcf0 2464=head2 $c->request_class
1f9cb7c1 2465
3f87d500 2466Returns or sets the request class. Defaults to L<Catalyst::Request>.
1f9cb7c1 2467
b5ecfcf0 2468=head2 $c->response_class
1f9cb7c1 2469
3f87d500 2470Returns or sets the response class. Defaults to L<Catalyst::Response>.
1f9cb7c1 2471
b5ecfcf0 2472=head2 $c->read( [$maxlength] )
fbcc39ad 2473
ae1e6b59 2474Reads a chunk of data from the request body. This method is designed to
2475be used in a while loop, reading C<$maxlength> bytes on every call.
2476C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2477
4600a5a1 2478You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
ae1e6b59 2479directly.
fbcc39ad 2480
878b821c 2481Warning: If you use read(), Catalyst will not process the body,
2482so you will not be able to access POST parameters or file uploads via
2483$c->request. You must handle all body parsing yourself.
2484
fbcc39ad 2485=cut
2486
f083854e 2487sub read { my $c = shift; return $c->request->read( @_ ) }
fbcc39ad 2488
b5ecfcf0 2489=head2 $c->run
fbcc39ad 2490
2491Starts the engine.
2492
2493=cut
2494
0c6352ff 2495sub run {
2496 my $app = shift;
38e43e65 2497 $app->_make_immutable_if_needed;
0c6352ff 2498 $app->engine_loader->needs_psgi_engine_compat_hack ?
2499 $app->engine->run($app, @_) :
2500 $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2501}
fbcc39ad 2502
38e43e65 2503sub _make_immutable_if_needed {
2504 my $class = shift;
dd5b1dc4 2505 my $meta = find_meta($class);
38e43e65 2506 my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2507 if (
2508 $meta->is_immutable
2509 && ! { $meta->immutable_options }->{replace_constructor}
2510 && $isa_ca
2511 ) {
2512 warn("You made your application class ($class) immutable, "
2513 . "but did not inline the\nconstructor. "
2514 . "This will break catalyst, as your app \@ISA "
2515 . "Class::Accessor(::Fast)?\nPlease pass "
2516 . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2517 }
2518 unless ($meta->is_immutable) {
2519 # XXX - FIXME warning here as you should make your app immutable yourself.
2520 $meta->make_immutable(
2521 replace_constructor => 1,
2522 );
2523 }
2524}
2525
b5ecfcf0 2526=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2527
e7f1cf73 2528Sets an action in a given namespace.
fbcc39ad 2529
2530=cut
2531
2532sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2533
b5ecfcf0 2534=head2 $c->setup_actions($component)
fbcc39ad 2535
e7f1cf73 2536Sets up actions for a component.
fbcc39ad 2537
2538=cut
2539
2540sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2541
b5ecfcf0 2542=head2 $c->setup_components
fbcc39ad 2543
d261d153 2544This method is called internally to set up the application's components.
fbcc39ad 2545
d261d153 2546It finds modules by calling the L<locate_components> method, expands them to
2547package names with the L<expand_component_module> method, and then installs
2548each component into the application.
2549
2550The C<setup_components> config option is passed to both of the above methods.
fbcc39ad 2551
d261d153 2552Installation of each component is performed by the L<setup_component> method,
2553below.
2f381252 2554
fbcc39ad 2555=cut
2556
2557sub setup_components {
2558 my $class = shift;
2559
18de900e 2560 my $config = $class->config->{ setup_components };
62a6df80 2561
69c6b6cb 2562 my @comps = $class->locate_components($config);
b94b200c 2563 my %comps = map { $_ => 1 } @comps;
73e1183e 2564
8f6cebb2 2565 my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
73e1183e 2566 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2567 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
8f6cebb2 2568 ) if $deprecatedcatalyst_component_names;
73e1183e 2569
b94b200c 2570 for my $component ( @comps ) {
dd91afb5 2571
2572 # We pass ignore_loaded here so that overlay files for (e.g.)
2573 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2574 # we know M::P::O found a file on disk so this is safe
2575
f5a4863c 2576 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
196f06d1 2577 }
2578
e7e4c469 2579 for my $component (@comps) {
5d02e790 2580 my $instance = $class->components->{ $component } = $class->setup_component($component);
2581 my @expanded_components = $instance->can('expand_modules')
2582 ? $instance->expand_modules( $component, $config )
2583 : $class->expand_component_module( $component, $config );
2584 for my $component (@expanded_components) {
05887b58 2585 next if $comps{$component};
e7e4c469 2586 $class->components->{ $component } = $class->setup_component($component);
fbcc39ad 2587 }
364d7324 2588 }
2589}
fbcc39ad 2590
d261d153 2591=head2 $c->locate_components( $setup_component_config )
2592
2593This method is meant to provide a list of component modules that should be
2594setup for the application. By default, it will use L<Module::Pluggable>.
2595
2596Specify a C<setup_components> config option to pass additional options directly
2597to L<Module::Pluggable>. To add additional search paths, specify a key named
2598C<search_extra> as an array reference. Items in the array beginning with C<::>
2599will have the application class name prepended to them.
2600
2601=cut
2602
2603sub locate_components {
2604 my $class = shift;
2605 my $config = shift;
2606
2607 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2608 my $extra = delete $config->{ search_extra } || [];
2609
2610 push @paths, @$extra;
2611
2612 my $locator = Module::Pluggable::Object->new(
2613 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2614 %$config
2615 );
2616
69c6b6cb 2617 # XXX think about ditching this sort entirely
2618 my @comps = sort { length $a <=> length $b } $locator->plugins;
d261d153 2619
2620 return @comps;
2621}
2622
2623=head2 $c->expand_component_module( $component, $setup_component_config )
2624
2625Components found by C<locate_components> will be passed to this method, which
2626is expected to return a list of component (package) names to be set up.
2627
d261d153 2628=cut
2629
2630sub expand_component_module {
2631 my ($class, $module) = @_;
05887b58 2632 return Devel::InnerPackage::list_packages( $module );
d261d153 2633}
2634
364d7324 2635=head2 $c->setup_component
fbcc39ad 2636
364d7324 2637=cut
fbcc39ad 2638
364d7324 2639sub setup_component {
2640 my( $class, $component ) = @_;
fbcc39ad 2641
364d7324 2642 unless ( $component->can( 'COMPONENT' ) ) {
2643 return $component;
2644 }
fbcc39ad 2645
364d7324 2646 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2647 my $config = $class->config->{ $suffix } || {};
8f6cebb2 2648 # Stash catalyst_component_name in the config here, so that custom COMPONENT
d2598ac8 2649 # methods also pass it. local to avoid pointlessly shitting in config
2650 # for the debug screen, as $component is already the key name.
8f6cebb2 2651 local $config->{catalyst_component_name} = $component;
fbcc39ad 2652
364d7324 2653 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2654
2655 if ( my $error = $@ ) {
fbcc39ad 2656 chomp $error;
fbcc39ad 2657 Catalyst::Exception->throw(
364d7324 2658 message => qq/Couldn't instantiate component "$component", "$error"/
2659 );
fbcc39ad 2660 }
2661
7490de2a 2662 unless (blessed $instance) {
2663 my $metaclass = Moose::Util::find_meta($component);
2664 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2665 my $component_method_from = $method_meta->associated_metaclass->name;
637fa644 2666 my $value = defined($instance) ? $instance : 'undef';
7490de2a 2667 Catalyst::Exception->throw(
2668 message =>
637fa644 2669 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
7490de2a 2670 );
2671 }
364d7324 2672 return $instance;
fbcc39ad 2673}
2674
b5ecfcf0 2675=head2 $c->setup_dispatcher
fbcc39ad 2676
ae1e6b59 2677Sets up dispatcher.
2678
fbcc39ad 2679=cut
2680
2681sub setup_dispatcher {
2682 my ( $class, $dispatcher ) = @_;
2683
2684 if ($dispatcher) {
2685 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2686 }
2687
cb69249e 2688 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2689 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2690 }
2691
2692 unless ($dispatcher) {
cb0354c6 2693 $dispatcher = $class->dispatcher_class;
fbcc39ad 2694 }
2695
e7399d8b 2696 load_class($dispatcher);
fbcc39ad 2697
2698 # dispatcher instance
2699 $class->dispatcher( $dispatcher->new );
2700}
2701
b5ecfcf0 2702=head2 $c->setup_engine
fbcc39ad 2703
ae1e6b59 2704Sets up engine.
2705
fbcc39ad 2706=cut
2707
1e5dad00 2708sub engine_class {
a8153308 2709 my ($class, $requested_engine) = @_;
2710
2711 if (!$class->engine_loader || $requested_engine) {
2712 $class->engine_loader(
2713 Catalyst::EngineLoader->new({
2714 application_name => $class,
2715 (defined $requested_engine
65420d46 2716 ? (catalyst_engine_class => $requested_engine) : ()),
a8153308 2717 }),
2718 );
2719 }
65420d46 2720
8ee06de7 2721 $class->engine_loader->catalyst_engine_class;
1e5dad00 2722}
2723
fbcc39ad 2724sub setup_engine {
a26a6adb 2725 my ($class, $requested_engine) = @_;
1085c936 2726
65420d46 2727 my $engine = do {
2728 my $loader = $class->engine_loader;
2729
2730 if (!$loader || $requested_engine) {
2731 $loader = Catalyst::EngineLoader->new({
2732 application_name => $class,
2733 (defined $requested_engine
2734 ? (requested_engine => $requested_engine) : ()),
2735 }),
2736
2737 $class->engine_loader($loader);
2738 }
2739
2740 $loader->catalyst_engine_class;
2741 };
1e5dad00 2742
2e1f92a3 2743 # Don't really setup_engine -- see _setup_psgi_app for explanation.
2744 return if $class->loading_psgi_file;
2745
e7399d8b 2746 load_class($engine);
0e7f5826 2747
532f0516 2748 if ($ENV{MOD_PERL}) {
1e5dad00 2749 my $apache = $class->engine_loader->auto;
ab4df9f8 2750
2751 my $meta = find_meta($class);
2752 my $was_immutable = $meta->is_immutable;
2753 my %immutable_options = $meta->immutable_options;
2754 $meta->make_mutable if $was_immutable;
2755
2756 $meta->add_method(handler => sub {
9fe15721 2757 my $r = shift;
c7250231 2758 my $psgi_app = $class->_finalized_psgi_app;
1e5dad00 2759 $apache->call_app($r, $psgi_app);
9fe15721 2760 });
ab4df9f8