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