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