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