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