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