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