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