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