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