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