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