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