Make _register_plugin use ensure_class_loaded
[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
51674a63 934 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
935
936 unshift(@args, $path);
937
938 unless (defined $path && $path =~ s!^/!!) { # in-place strip
939 my $namespace = $c->namespace;
940 if (defined $path) { # cheesy hack to handle path '../foo'
941 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 942 }
51674a63 943 unshift(@args, $namespace || '');
944 }
5789a3d8 945
189e2a51 946 # join args with '/', or a blank string
51674a63 947 my $args = join('/', grep { defined($_) } @args);
948 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
949 $args =~ s!^/!!;
950 my $base = $c->req->base;
951 my $class = ref($base);
952 $base =~ s{(?<!/)$}{/};
953
954 my $query = '';
955
956 if (my @keys = keys %$params) {
957 # somewhat lifted from URI::_query's query_form
958 $query = '?'.join('&', map {
959 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
960 s/ /+/g;
961 my $key = $_;
962 my $val = $params->{$_};
963 $val = '' unless defined $val;
964 (map {
965 $_ = "$_";
966 utf8::encode( $_ );
967 # using the URI::Escape pattern here so utf8 chars survive
968 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
969 s/ /+/g;
970 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
971 } @keys);
972 }
973
974 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 975 $res;
fbcc39ad 976}
977
b5ecfcf0 978=head2 $c->welcome_message
ab2374d3 979
980Returns the Catalyst welcome HTML page.
981
982=cut
983
984sub welcome_message {
bf1f2c60 985 my $c = shift;
986 my $name = $c->config->{name};
987 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
988 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 989 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 990 return <<"EOF";
80cdbbff 991<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
992 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
993<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 994 <head>
80cdbbff 995 <meta http-equiv="Content-Language" content="en" />
996 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 997 <title>$name on Catalyst $VERSION</title>
998 <style type="text/css">
999 body {
ab2374d3 1000 color: #000;
1001 background-color: #eee;
1002 }
1003 div#content {
1004 width: 640px;
80cdbbff 1005 margin-left: auto;
1006 margin-right: auto;
ab2374d3 1007 margin-top: 10px;
1008 margin-bottom: 10px;
1009 text-align: left;
1010 background-color: #ccc;
1011 border: 1px solid #aaa;
ab2374d3 1012 }
d84c4dab 1013 p, h1, h2 {
ab2374d3 1014 margin-left: 20px;
1015 margin-right: 20px;
16215972 1016 font-family: verdana, tahoma, sans-serif;
ab2374d3 1017 }
d84c4dab 1018 a {
1019 font-family: verdana, tahoma, sans-serif;
1020 }
d114e033 1021 :link, :visited {
1022 text-decoration: none;
1023 color: #b00;
1024 border-bottom: 1px dotted #bbb;
1025 }
1026 :link:hover, :visited:hover {
d114e033 1027 color: #555;
1028 }
ab2374d3 1029 div#topbar {
1030 margin: 0px;
1031 }
3e82a295 1032 pre {
3e82a295 1033 margin: 10px;
1034 padding: 8px;
1035 }
ab2374d3 1036 div#answers {
1037 padding: 8px;
1038 margin: 10px;
d114e033 1039 background-color: #fff;
ab2374d3 1040 border: 1px solid #aaa;
ab2374d3 1041 }
1042 h1 {
33108eaf 1043 font-size: 0.9em;
1044 font-weight: normal;
ab2374d3 1045 text-align: center;
1046 }
1047 h2 {
1048 font-size: 1.0em;
1049 }
1050 p {
1051 font-size: 0.9em;
1052 }
ae7c5252 1053 p img {
1054 float: right;
1055 margin-left: 10px;
1056 }
9619f23c 1057 span#appname {
1058 font-weight: bold;
33108eaf 1059 font-size: 1.6em;
ab2374d3 1060 }
1061 </style>
1062 </head>
1063 <body>
1064 <div id="content">
1065 <div id="topbar">
9619f23c 1066 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1067 $VERSION</h1>
ab2374d3 1068 </div>
1069 <div id="answers">
ae7c5252 1070 <p>
80cdbbff 1071 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1072 </p>
596aaffe 1073 <p>Welcome to the world of Catalyst.
f92fd545 1074 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1075 framework will make web development something you had
60dd6e1d 1076 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1077 <h2>What to do now?</h2>
4b8cb778 1078 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1079 We do, however, provide you with a few starting points.</p>
1080 <p>If you want to jump right into web development with Catalyst
596aaffe 1081 you might want want to start with a tutorial.</p>
b607f8a0 1082<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
596aaffe 1083</pre>
1084<p>Afterwards you can go on to check out a more complete look at our features.</p>
1085<pre>
b607f8a0 1086<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1087<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1088</code></pre>
ab2374d3 1089 <h2>What to do next?</h2>
f5681c92 1090 <p>Next it's time to write an actual application. Use the
80cdbbff 1091 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 1092 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1093 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 1094 they can save you a lot of work.</p>
1095 <pre><code>script/${prefix}_create.pl -help</code></pre>
1096 <p>Also, be sure to check out the vast and growing
60dd6e1d 1097 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 1098 you are likely to find what you need there.
f5681c92 1099 </p>
1100
82245cc4 1101 <h2>Need help?</h2>
f5681c92 1102 <p>Catalyst has a very active community. Here are the main places to
1103 get in touch with us.</p>
16215972 1104 <ul>
1105 <li>
2b9a7d76 1106 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1107 </li>
1108 <li>
1109 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
1110 </li>
1111 <li>
4eaf7c88 1112 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1113 </li>
1114 </ul>
ab2374d3 1115 <h2>In conclusion</h2>
4e7aa2ea 1116 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1117 as we enjoyed making it. Please contact us if you have ideas
1118 for improvement or other feedback.</p>
ab2374d3 1119 </div>
1120 </div>
1121 </body>
1122</html>
1123EOF
1124}
1125
fbcc39ad 1126=head1 INTERNAL METHODS
1127
ae1e6b59 1128These methods are not meant to be used by end users.
1129
b5ecfcf0 1130=head2 $c->components
fbcc39ad 1131
e7f1cf73 1132Returns a hash of components.
fbcc39ad 1133
b5ecfcf0 1134=head2 $c->context_class
1f9cb7c1 1135
e7f1cf73 1136Returns or sets the context class.
1f9cb7c1 1137
b5ecfcf0 1138=head2 $c->counter
fbcc39ad 1139
ae1e6b59 1140Returns a hashref containing coderefs and execution counts (needed for
1141deep recursion detection).
fbcc39ad 1142
b5ecfcf0 1143=head2 $c->depth
fbcc39ad 1144
e7f1cf73 1145Returns the number of actions on the current internal execution stack.
fbcc39ad 1146
b5ecfcf0 1147=head2 $c->dispatch
fbcc39ad 1148
e7f1cf73 1149Dispatches a request to actions.
fbcc39ad 1150
1151=cut
1152
1153sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1154
b5ecfcf0 1155=head2 $c->dispatcher_class
1f9cb7c1 1156
e7f1cf73 1157Returns or sets the dispatcher class.
1f9cb7c1 1158
b5ecfcf0 1159=head2 $c->dump_these
7f92deef 1160
ae1e6b59 1161Returns a list of 2-element array references (name, structure) pairs
1162that will be dumped on the error page in debug mode.
7f92deef 1163
1164=cut
1165
1166sub dump_these {
1167 my $c = shift;
052a2d89 1168 [ Request => $c->req ],
1169 [ Response => $c->res ],
1170 [ Stash => $c->stash ],
1171 [ Config => $c->config ];
7f92deef 1172}
1173
b5ecfcf0 1174=head2 $c->engine_class
1f9cb7c1 1175
e7f1cf73 1176Returns or sets the engine class.
1f9cb7c1 1177
b5ecfcf0 1178=head2 $c->execute( $class, $coderef )
fbcc39ad 1179
0ef52a96 1180Execute a coderef in given class and catch exceptions. Errors are available
1181via $c->error.
fbcc39ad 1182
1183=cut
1184
1185sub execute {
1186 my ( $c, $class, $code ) = @_;
858828dd 1187 $class = $c->component($class) || $class;
fbcc39ad 1188 $c->state(0);
a0eca838 1189
197bd788 1190 if ( $c->depth >= $RECURSION ) {
1627551a 1191 my $action = "$code";
91d08727 1192 $action = "/$action" unless $action =~ /->/;
1627551a 1193 my $error = qq/Deep recursion detected calling "$action"/;
1194 $c->log->error($error);
1195 $c->error($error);
1196 $c->state(0);
1197 return $c->state;
1198 }
1199
a6724a82 1200 my $stats_info = $c->_stats_start_execute( $code ) if $c->debug;
22247e54 1201
8767c5a3 1202 push( @{ $c->stack }, $code );
7a7d7af5 1203
245ae014 1204 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1205
a6724a82 1206 $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info;
7a7d7af5 1207
a6724a82 1208 my $last = pop( @{ $c->stack } );
fbcc39ad 1209
1210 if ( my $error = $@ ) {
88879e92 1211 if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
fbcc39ad 1212 else {
1213 unless ( ref $error ) {
91d08727 1214 no warnings 'uninitialized';
fbcc39ad 1215 chomp $error;
f59def82 1216 my $class = $last->class;
1217 my $name = $last->name;
1218 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1219 }
fbcc39ad 1220 $c->error($error);
1221 $c->state(0);
1222 }
1223 }
1224 return $c->state;
1225}
1226
7a7d7af5 1227sub _stats_start_execute {
1228 my ( $c, $code ) = @_;
1229
a6724a82 1230 return if ( ( $code->name =~ /^_.*/ )
1231 && ( !$c->config->{show_internal_actions} ) );
7a7d7af5 1232
7a7d7af5 1233 $c->counter->{"$code"}++;
1234
a6724a82 1235 my $action = "$code";
1236 $action = "/$action" unless $action =~ /->/;
1237
7a7d7af5 1238 # determine if the call was the result of a forward
1239 # this is done by walking up the call stack and looking for a calling
1240 # sub of Catalyst::forward before the eval
1241 my $callsub = q{};
1242 for my $index ( 2 .. 11 ) {
1243 last
1244 if ( ( caller($index) )[0] eq 'Catalyst'
1245 && ( caller($index) )[3] eq '(eval)' );
1246
1247 if ( ( caller($index) )[3] =~ /forward$/ ) {
1248 $callsub = ( caller($index) )[3];
1249 $action = "-> $action";
1250 last;
1251 }
1252 }
1253
1254 my $node = Tree::Simple->new(
1255 {
1256 action => $action,
1257 elapsed => undef, # to be filled in later
1258 comment => "",
1259 }
1260 );
1261 $node->setUID( "$code" . $c->counter->{"$code"} );
1262
a6724a82 1263 # is this a root-level call or a forwarded call?
1264 if ( $callsub =~ /forward$/ ) {
1265
1266 # forward, locate the caller
1267 if ( my $parent = $c->stack->[-1] ) {
1268 my $visitor = Tree::Simple::Visitor::FindByUID->new;
1269 $visitor->searchForUID(
1270 "$parent" . $c->counter->{"$parent"} );
1271 $c->stats->accept($visitor);
1272 if ( my $result = $visitor->getResult ) {
1273 $result->addChild($node);
7a7d7af5 1274 }
1275 }
1276 else {
1277
a6724a82 1278 # forward with no caller may come from a plugin
7a7d7af5 1279 $c->stats->addChild($node);
1280 }
1281 }
a6724a82 1282 else {
7a7d7af5 1283
a6724a82 1284 # root-level call
1285 $c->stats->addChild($node);
1286 }
7a7d7af5 1287
1288 return {
a6724a82 1289 start => [gettimeofday],
7a7d7af5 1290 node => $node,
a6724a82 1291 };
7a7d7af5 1292}
1293
1294sub _stats_finish_execute {
1295 my ( $c, $info ) = @_;
dea1884f 1296 my $elapsed = tv_interval $info->{start};
1297 my $value = $info->{node}->getNodeValue;
a6724a82 1298 $value->{elapsed} = sprintf( '%fs', $elapsed );
7a7d7af5 1299}
1300
3d0d6d21 1301=head2 $c->_localize_fields( sub { }, \%keys );
1302
1303=cut
1304
1305sub _localize_fields {
1306 my ( $c, $localized, $code ) = ( @_ );
1307
1308 my $request = delete $localized->{request} || {};
1309 my $response = delete $localized->{response} || {};
1310
1311 local @{ $c }{ keys %$localized } = values %$localized;
1312 local @{ $c->request }{ keys %$request } = values %$request;
1313 local @{ $c->response }{ keys %$response } = values %$response;
1314
1315 $code->();
1316}
1317
b5ecfcf0 1318=head2 $c->finalize
fbcc39ad 1319
e7f1cf73 1320Finalizes the request.
fbcc39ad 1321
1322=cut
1323
1324sub finalize {
1325 my $c = shift;
1326
369c09bc 1327 for my $error ( @{ $c->error } ) {
1328 $c->log->error($error);
1329 }
1330
5050d7a7 1331 # Allow engine to handle finalize flow (for POE)
1332 if ( $c->engine->can('finalize') ) {
34d28dfd 1333 $c->engine->finalize($c);
fbcc39ad 1334 }
5050d7a7 1335 else {
fbcc39ad 1336
5050d7a7 1337 $c->finalize_uploads;
fbcc39ad 1338
5050d7a7 1339 # Error
1340 if ( $#{ $c->error } >= 0 ) {
1341 $c->finalize_error;
1342 }
1343
1344 $c->finalize_headers;
fbcc39ad 1345
5050d7a7 1346 # HEAD request
1347 if ( $c->request->method eq 'HEAD' ) {
1348 $c->response->body('');
1349 }
1350
1351 $c->finalize_body;
1352 }
908e3d9e 1353
1354 if ($c->debug) {
1355 my $elapsed = sprintf '%f', tv_interval($c->stats->getNodeValue);
1356 my $av = sprintf '%.3f', ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1357
1358 my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
1359 $c->stats->traverse(
1360 sub {
1361 my $action = shift;
1362 my $stat = $action->getNodeValue;
1363 $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
1364 $stat->{elapsed} || '??' );
1365 }
1366 );
1367
1368 $c->log->info(
1cf0345b 1369 "Request took ${elapsed}s ($av/s)\n" . $t->draw . "\n" );
908e3d9e 1370 }
fbcc39ad 1371
1372 return $c->response->status;
1373}
1374
b5ecfcf0 1375=head2 $c->finalize_body
fbcc39ad 1376
e7f1cf73 1377Finalizes body.
fbcc39ad 1378
1379=cut
1380
1381sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1382
b5ecfcf0 1383=head2 $c->finalize_cookies
fbcc39ad 1384
e7f1cf73 1385Finalizes cookies.
fbcc39ad 1386
1387=cut
1388
147821ea 1389sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1390
b5ecfcf0 1391=head2 $c->finalize_error
fbcc39ad 1392
e7f1cf73 1393Finalizes error.
fbcc39ad 1394
1395=cut
1396
1397sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1398
b5ecfcf0 1399=head2 $c->finalize_headers
fbcc39ad 1400
e7f1cf73 1401Finalizes headers.
fbcc39ad 1402
1403=cut
1404
1405sub finalize_headers {
1406 my $c = shift;
1407
1408 # Check if we already finalized headers
1409 return if $c->response->{_finalized_headers};
1410
1411 # Handle redirects
1412 if ( my $location = $c->response->redirect ) {
1413 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1414 $c->response->header( Location => $location );
39655cdc 1415
1416 if ( !$c->response->body ) {
1417 # Add a default body if none is already present
1418 $c->response->body(
e422816e 1419 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
39655cdc 1420 );
1421 }
fbcc39ad 1422 }
1423
1424 # Content-Length
1425 if ( $c->response->body && !$c->response->content_length ) {
775878ac 1426
8f62c91a 1427 # get the length from a filehandle
197bd788 1428 if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1429 {
3b6a1db1 1430 my $stat = stat $c->response->body;
1431 if ( $stat && $stat->size > 0 ) {
8f62c91a 1432 $c->response->content_length( $stat->size );
1433 }
1434 else {
775878ac 1435 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1436 }
1437 }
1438 else {
775878ac 1439 $c->response->content_length( bytes::length( $c->response->body ) );
8f62c91a 1440 }
fbcc39ad 1441 }
1442
1443 # Errors
1444 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1445 $c->response->headers->remove_header("Content-Length");
1446 $c->response->body('');
1447 }
1448
1449 $c->finalize_cookies;
1450
1451 $c->engine->finalize_headers( $c, @_ );
1452
1453 # Done
1454 $c->response->{_finalized_headers} = 1;
1455}
1456
b5ecfcf0 1457=head2 $c->finalize_output
fbcc39ad 1458
1459An alias for finalize_body.
1460
b5ecfcf0 1461=head2 $c->finalize_read
fbcc39ad 1462
e7f1cf73 1463Finalizes the input after reading is complete.
fbcc39ad 1464
1465=cut
1466
1467sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1468
b5ecfcf0 1469=head2 $c->finalize_uploads
fbcc39ad 1470
ae1e6b59 1471Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1472
1473=cut
1474
1475sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1476
b5ecfcf0 1477=head2 $c->get_action( $action, $namespace )
fbcc39ad 1478
e7f1cf73 1479Gets an action in a given namespace.
fbcc39ad 1480
1481=cut
1482
684d10ed 1483sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1484
b5ecfcf0 1485=head2 $c->get_actions( $action, $namespace )
a9dc674c 1486
ae1e6b59 1487Gets all actions of a given name in a namespace and all parent
1488namespaces.
a9dc674c 1489
1490=cut
1491
1492sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1493
f7b672ef 1494=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1495
e7f1cf73 1496Called to handle each HTTP request.
fbcc39ad 1497
1498=cut
1499
1500sub handle_request {
1501 my ( $class, @arguments ) = @_;
1502
1503 # Always expect worst case!
1504 my $status = -1;
1505 eval {
dea1884f 1506 if ($class->debug) {
908e3d9e 1507 my $secs = time - $START || 1;
1508 my $av = sprintf '%.3f', $COUNT / $secs;
1509 my $time = localtime time;
1510 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1511 }
908e3d9e 1512
1513 my $c = $class->prepare(@arguments);
1514 $c->dispatch;
1515 $status = $c->finalize;
fbcc39ad 1516 };
1517
1518 if ( my $error = $@ ) {
1519 chomp $error;
1520 $class->log->error(qq/Caught exception in engine "$error"/);
1521 }
1522
1523 $COUNT++;
1524 $class->log->_flush() if $class->log->can('_flush');
1525 return $status;
1526}
1527
b5ecfcf0 1528=head2 $c->prepare( @arguments )
fbcc39ad 1529
ae1e6b59 1530Creates a Catalyst context from an engine-specific request (Apache, CGI,
1531etc.).
fbcc39ad 1532
1533=cut
1534
1535sub prepare {
1536 my ( $class, @arguments ) = @_;
1537
3cec521a 1538 $class->context_class( ref $class || $class ) unless $class->context_class;
1539 my $c = $class->context_class->new(
1540 {
1541 counter => {},
28591cd7 1542 stack => [],
3cec521a 1543 request => $class->request_class->new(
1544 {
1545 arguments => [],
1546 body_parameters => {},
1547 cookies => {},
1548 headers => HTTP::Headers->new,
1549 parameters => {},
1550 query_parameters => {},
1551 secure => 0,
2982e768 1552 captures => [],
3cec521a 1553 uploads => {}
1554 }
1555 ),
1556 response => $class->response_class->new(
1557 {
1558 body => '',
1559 cookies => {},
1560 headers => HTTP::Headers->new(),
1561 status => 200
1562 }
1563 ),
1564 stash => {},
1565 state => 0
1566 }
1567 );
fbcc39ad 1568
908e3d9e 1569 if ( $c->debug ) {
1570 $c->stats(Tree::Simple->new([gettimeofday]));
1571 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1572 }
1573
fbcc39ad 1574 # For on-demand data
1575 $c->request->{_context} = $c;
1576 $c->response->{_context} = $c;
1577 weaken( $c->request->{_context} );
1578 weaken( $c->response->{_context} );
1579
5050d7a7 1580 # Allow engine to direct the prepare flow (for POE)
1581 if ( $c->engine->can('prepare') ) {
1582 $c->engine->prepare( $c, @arguments );
1583 }
1584 else {
1585 $c->prepare_request(@arguments);
1586 $c->prepare_connection;
1587 $c->prepare_query_parameters;
1588 $c->prepare_headers;
1589 $c->prepare_cookies;
1590 $c->prepare_path;
1591
1592 # On-demand parsing
1593 $c->prepare_body unless $c->config->{parse_on_demand};
1594 }
fbcc39ad 1595
fbcc39ad 1596 my $method = $c->req->method || '';
34d28dfd 1597 my $path = $c->req->path || '/';
fbcc39ad 1598 my $address = $c->req->address || '';
1599
e3a13771 1600 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1601 if $c->debug;
1602
e3a13771 1603 $c->prepare_action;
1604
fbcc39ad 1605 return $c;
1606}
1607
b5ecfcf0 1608=head2 $c->prepare_action
fbcc39ad 1609
b4b01a8a 1610Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1611
1612=cut
1613
1614sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1615
b5ecfcf0 1616=head2 $c->prepare_body
fbcc39ad 1617
e7f1cf73 1618Prepares message body.
fbcc39ad 1619
1620=cut
1621
1622sub prepare_body {
1623 my $c = shift;
1624
1625 # Do we run for the first time?
1626 return if defined $c->request->{_body};
1627
1628 # Initialize on-demand data
1629 $c->engine->prepare_body( $c, @_ );
1630 $c->prepare_parameters;
1631 $c->prepare_uploads;
1632
1633 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
34d28dfd 1634 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
fbcc39ad 1635 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1636 my $param = $c->req->body_parameters->{$key};
1637 my $value = defined($param) ? $param : '';
8c113188 1638 $t->row( $key,
fbcc39ad 1639 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1640 }
1641 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1642 }
1643}
1644
b5ecfcf0 1645=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1646
e7f1cf73 1647Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1648
b4b01a8a 1649See L<Catalyst::Engine>.
1650
4bd82c41 1651=cut
1652
4f5ebacd 1653sub prepare_body_chunk {
1654 my $c = shift;
4bd82c41 1655 $c->engine->prepare_body_chunk( $c, @_ );
1656}
1657
b5ecfcf0 1658=head2 $c->prepare_body_parameters
fbcc39ad 1659
e7f1cf73 1660Prepares body parameters.
fbcc39ad 1661
1662=cut
1663
1664sub prepare_body_parameters {
1665 my $c = shift;
1666 $c->engine->prepare_body_parameters( $c, @_ );
1667}
1668
b5ecfcf0 1669=head2 $c->prepare_connection
fbcc39ad 1670
e7f1cf73 1671Prepares connection.
fbcc39ad 1672
1673=cut
1674
1675sub prepare_connection {
1676 my $c = shift;
1677 $c->engine->prepare_connection( $c, @_ );
1678}
1679
b5ecfcf0 1680=head2 $c->prepare_cookies
fbcc39ad 1681
e7f1cf73 1682Prepares cookies.
fbcc39ad 1683
1684=cut
1685
1686sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1687
b5ecfcf0 1688=head2 $c->prepare_headers
fbcc39ad 1689
e7f1cf73 1690Prepares headers.
fbcc39ad 1691
1692=cut
1693
1694sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1695
b5ecfcf0 1696=head2 $c->prepare_parameters
fbcc39ad 1697
e7f1cf73 1698Prepares parameters.
fbcc39ad 1699
1700=cut
1701
1702sub prepare_parameters {
1703 my $c = shift;
1704 $c->prepare_body_parameters;
1705 $c->engine->prepare_parameters( $c, @_ );
1706}
1707
b5ecfcf0 1708=head2 $c->prepare_path
fbcc39ad 1709
e7f1cf73 1710Prepares path and base.
fbcc39ad 1711
1712=cut
1713
1714sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1715
b5ecfcf0 1716=head2 $c->prepare_query_parameters
fbcc39ad 1717
e7f1cf73 1718Prepares query parameters.
fbcc39ad 1719
1720=cut
1721
1722sub prepare_query_parameters {
1723 my $c = shift;
1724
1725 $c->engine->prepare_query_parameters( $c, @_ );
1726
1727 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
34d28dfd 1728 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
fbcc39ad 1729 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1730 my $param = $c->req->query_parameters->{$key};
1731 my $value = defined($param) ? $param : '';
8c113188 1732 $t->row( $key,
fbcc39ad 1733 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1734 }
1735 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1736 }
1737}
1738
b5ecfcf0 1739=head2 $c->prepare_read
fbcc39ad 1740
e7f1cf73 1741Prepares the input for reading.
fbcc39ad 1742
1743=cut
1744
1745sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1746
b5ecfcf0 1747=head2 $c->prepare_request
fbcc39ad 1748
e7f1cf73 1749Prepares the engine request.
fbcc39ad 1750
1751=cut
1752
1753sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1754
b5ecfcf0 1755=head2 $c->prepare_uploads
fbcc39ad 1756
e7f1cf73 1757Prepares uploads.
fbcc39ad 1758
1759=cut
1760
1761sub prepare_uploads {
1762 my $c = shift;
1763
1764 $c->engine->prepare_uploads( $c, @_ );
1765
1766 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1767 my $t = Text::SimpleTable->new(
34d28dfd 1768 [ 12, 'Parameter' ],
1769 [ 26, 'Filename' ],
8c113188 1770 [ 18, 'Type' ],
1771 [ 9, 'Size' ]
1772 );
fbcc39ad 1773 for my $key ( sort keys %{ $c->request->uploads } ) {
1774 my $upload = $c->request->uploads->{$key};
1775 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1776 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1777 }
1778 }
1779 $c->log->debug( "File Uploads are:\n" . $t->draw );
1780 }
1781}
1782
b5ecfcf0 1783=head2 $c->prepare_write
fbcc39ad 1784
e7f1cf73 1785Prepares the output for writing.
fbcc39ad 1786
1787=cut
1788
1789sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1790
b5ecfcf0 1791=head2 $c->request_class
1f9cb7c1 1792
e7f1cf73 1793Returns or sets the request class.
1f9cb7c1 1794
b5ecfcf0 1795=head2 $c->response_class
1f9cb7c1 1796
e7f1cf73 1797Returns or sets the response class.
1f9cb7c1 1798
b5ecfcf0 1799=head2 $c->read( [$maxlength] )
fbcc39ad 1800
ae1e6b59 1801Reads a chunk of data from the request body. This method is designed to
1802be used in a while loop, reading C<$maxlength> bytes on every call.
1803C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 1804
cc95842f 1805You have to set C<< MyApp->config->{parse_on_demand} >> to use this
ae1e6b59 1806directly.
fbcc39ad 1807
1808=cut
1809
1810sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1811
b5ecfcf0 1812=head2 $c->run
fbcc39ad 1813
1814Starts the engine.
1815
1816=cut
1817
1818sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1819
b5ecfcf0 1820=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 1821
e7f1cf73 1822Sets an action in a given namespace.
fbcc39ad 1823
1824=cut
1825
1826sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1827
b5ecfcf0 1828=head2 $c->setup_actions($component)
fbcc39ad 1829
e7f1cf73 1830Sets up actions for a component.
fbcc39ad 1831
1832=cut
1833
1834sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1835
b5ecfcf0 1836=head2 $c->setup_components
fbcc39ad 1837
86418559 1838Sets up components. Specify a C<setup_components> config option to pass
1839additional options directly to L<Module::Pluggable>. To add additional
1840search paths, specify a key named C<search_extra> as an array
1841reference. Items in the array beginning with C<::> will have the
18de900e 1842application class name prepended to them.
fbcc39ad 1843
1844=cut
1845
1846sub setup_components {
1847 my $class = shift;
1848
18de900e 1849 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
1850 my $config = $class->config->{ setup_components };
1851 my $extra = delete $config->{ search_extra } || [];
1852
1853 push @paths, @$extra;
1854
364d7324 1855 my $locator = Module::Pluggable::Object->new(
18de900e 1856 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1857 %$config
364d7324 1858 );
b94b200c 1859
1860 my @comps = sort { length $a <=> length $b } $locator->plugins;
1861 my %comps = map { $_ => 1 } @comps;
364d7324 1862
b94b200c 1863 for my $component ( @comps ) {
d06051f7 1864 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
364d7324 1865
1866 my $module = $class->setup_component( $component );
1867 my %modules = (
1868 $component => $module,
1869 map {
1870 $_ => $class->setup_component( $_ )
b94b200c 1871 } grep {
1872 not exists $comps{$_}
364d7324 1873 } Devel::InnerPackage::list_packages( $component )
1874 );
1875
1876 for my $key ( keys %modules ) {
1877 $class->components->{ $key } = $modules{ $key };
fbcc39ad 1878 }
364d7324 1879 }
1880}
fbcc39ad 1881
364d7324 1882=head2 $c->setup_component
fbcc39ad 1883
364d7324 1884=cut
fbcc39ad 1885
364d7324 1886sub setup_component {
1887 my( $class, $component ) = @_;
fbcc39ad 1888
364d7324 1889 unless ( $component->can( 'COMPONENT' ) ) {
1890 return $component;
1891 }
fbcc39ad 1892
364d7324 1893 my $suffix = Catalyst::Utils::class2classsuffix( $component );
1894 my $config = $class->config->{ $suffix } || {};
fbcc39ad 1895
364d7324 1896 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 1897
1898 if ( my $error = $@ ) {
fbcc39ad 1899 chomp $error;
fbcc39ad 1900 Catalyst::Exception->throw(
364d7324 1901 message => qq/Couldn't instantiate component "$component", "$error"/
1902 );
fbcc39ad 1903 }
1904
364d7324 1905 Catalyst::Exception->throw(
1906 message =>
1907 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
1908 ) unless eval { $instance->can( 'can' ) };
1909
1910 return $instance;
fbcc39ad 1911}
1912
b5ecfcf0 1913=head2 $c->setup_dispatcher
fbcc39ad 1914
ae1e6b59 1915Sets up dispatcher.
1916
fbcc39ad 1917=cut
1918
1919sub setup_dispatcher {
1920 my ( $class, $dispatcher ) = @_;
1921
1922 if ($dispatcher) {
1923 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1924 }
1925
1926 if ( $ENV{CATALYST_DISPATCHER} ) {
1927 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1928 }
1929
1930 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1931 $dispatcher =
1932 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1933 }
1934
1935 unless ($dispatcher) {
cb0354c6 1936 $dispatcher = $class->dispatcher_class;
fbcc39ad 1937 }
1938
1e514a51 1939 unless (Class::Inspector->loaded($dispatcher)) {
1940 require Class::Inspector->filename($dispatcher);
fbcc39ad 1941 }
1942
1943 # dispatcher instance
1944 $class->dispatcher( $dispatcher->new );
1945}
1946
b5ecfcf0 1947=head2 $c->setup_engine
fbcc39ad 1948
ae1e6b59 1949Sets up engine.
1950
fbcc39ad 1951=cut
1952
1953sub setup_engine {
1954 my ( $class, $engine ) = @_;
1955
1956 if ($engine) {
1957 $engine = 'Catalyst::Engine::' . $engine;
1958 }
1959
1960 if ( $ENV{CATALYST_ENGINE} ) {
1961 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1962 }
1963
1964 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1965 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1966 }
1967
9b0a3e0f 1968 if ( $ENV{MOD_PERL} ) {
fbcc39ad 1969
1970 # create the apache method
1971 {
1972 no strict 'refs';
1973 *{"$class\::apache"} = sub { shift->engine->apache };
1974 }
1975
1976 my ( $software, $version ) =
1977 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1978
1979 $version =~ s/_//g;
1980 $version =~ s/(\.[^.]+)\./$1/g;
1981
1982 if ( $software eq 'mod_perl' ) {
1983
9b0a3e0f 1984 if ( !$engine ) {
22247e54 1985
9b0a3e0f 1986 if ( $version >= 1.99922 ) {
1987 $engine = 'Catalyst::Engine::Apache2::MP20';
1988 }
22247e54 1989
9b0a3e0f 1990 elsif ( $version >= 1.9901 ) {
1991 $engine = 'Catalyst::Engine::Apache2::MP19';
1992 }
22247e54 1993
9b0a3e0f 1994 elsif ( $version >= 1.24 ) {
1995 $engine = 'Catalyst::Engine::Apache::MP13';
1996 }
22247e54 1997
9b0a3e0f 1998 else {
1999 Catalyst::Exception->throw( message =>
2000 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2001 }
fbcc39ad 2002
fbcc39ad 2003 }
2004
2005 # install the correct mod_perl handler
2006 if ( $version >= 1.9901 ) {
2007 *handler = sub : method {
2008 shift->handle_request(@_);
2009 };
2010 }
2011 else {
2012 *handler = sub ($$) { shift->handle_request(@_) };
2013 }
2014
2015 }
2016
2017 elsif ( $software eq 'Zeus-Perl' ) {
2018 $engine = 'Catalyst::Engine::Zeus';
2019 }
2020
2021 else {
2022 Catalyst::Exception->throw(
2023 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2024 }
2025 }
2026
2027 unless ($engine) {
cb0354c6 2028 $engine = $class->engine_class;
fbcc39ad 2029 }
2030
1e514a51 2031 unless (Class::Inspector->loaded($engine)) {
2032 require Class::Inspector->filename($engine);
fbcc39ad 2033 }
0e7f5826 2034
d54484bf 2035 # check for old engines that are no longer compatible
2036 my $old_engine;
0e7f5826 2037 if ( $engine->isa('Catalyst::Engine::Apache')
2038 && !Catalyst::Engine::Apache->VERSION )
d54484bf 2039 {
2040 $old_engine = 1;
2041 }
0e7f5826 2042
d54484bf 2043 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 2044 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 2045 {
2046 $old_engine = 1;
2047 }
0e7f5826 2048
2049 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2050 && $engine->VERSION eq '0.01' )
d54484bf 2051 {
2052 $old_engine = 1;
2053 }
0e7f5826 2054
2055 elsif ($engine->isa('Catalyst::Engine::Zeus')
2056 && $engine->VERSION eq '0.01' )
d54484bf 2057 {
2058 $old_engine = 1;
2059 }
fbcc39ad 2060
d54484bf 2061 if ($old_engine) {
2062 Catalyst::Exception->throw( message =>
0e7f5826 2063 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2064 );
2065 }
0e7f5826 2066
fbcc39ad 2067 # engine instance
2068 $class->engine( $engine->new );
2069}
2070
b5ecfcf0 2071=head2 $c->setup_home
fbcc39ad 2072
ae1e6b59 2073Sets up the home directory.
2074
fbcc39ad 2075=cut
2076
2077sub setup_home {
2078 my ( $class, $home ) = @_;
2079
2080 if ( $ENV{CATALYST_HOME} ) {
2081 $home = $ENV{CATALYST_HOME};
2082 }
2083
2084 if ( $ENV{ uc($class) . '_HOME' } ) {
cc95842f 2085 $class =~ s/::/_/g;
fbcc39ad 2086 $home = $ENV{ uc($class) . '_HOME' };
2087 }
2088
2089 unless ($home) {
2090 $home = Catalyst::Utils::home($class);
2091 }
2092
2093 if ($home) {
2094 $class->config->{home} ||= $home;
a738ab68 2095 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2096 }
2097}
2098
b5ecfcf0 2099=head2 $c->setup_log
fbcc39ad 2100
ae1e6b59 2101Sets up log.
2102
fbcc39ad 2103=cut
2104
2105sub setup_log {
2106 my ( $class, $debug ) = @_;
2107
2108 unless ( $class->log ) {
2109 $class->log( Catalyst::Log->new );
2110 }
af3ff00e 2111
71f074a9 2112 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
71f074a9 2113
af3ff00e 2114 if (
2115 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
2116 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
2117 : $debug
2118 )
2119 {
fbcc39ad 2120 no strict 'refs';
2121 *{"$class\::debug"} = sub { 1 };
2122 $class->log->debug('Debug messages enabled');
2123 }
2124}
2125
b5ecfcf0 2126=head2 $c->setup_plugins
fbcc39ad 2127
ae1e6b59 2128Sets up plugins.
2129
fbcc39ad 2130=cut
2131
836e1134 2132=head2 $c->registered_plugins
2133
2134Returns a sorted list of the plugins which have either been stated in the
2135import list or which have been added via C<< MyApp->plugin(@args); >>.
2136
2137If passed a given plugin name, it will report a boolean value indicating
2138whether or not that plugin is loaded. A fully qualified name is required if
2139the plugin name does not begin with C<Catalyst::Plugin::>.
2140
2141 if ($c->registered_plugins('Some::Plugin')) {
2142 ...
2143 }
2144
2145=cut
fbcc39ad 2146
836e1134 2147{
97b58e17 2148
2149 sub registered_plugins {
836e1134 2150 my $proto = shift;
197bd788 2151 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2152 my $plugin = shift;
d0d4d785 2153 return 1 if exists $proto->_plugins->{$plugin};
2154 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2155 }
fbcc39ad 2156
836e1134 2157 sub _register_plugin {
2158 my ( $proto, $plugin, $instant ) = @_;
2159 my $class = ref $proto || $proto;
fbcc39ad 2160
893f05d2 2161 Catalyst::Utils::ensure_class_loaded( $plugin, { ignore_loaded => 1 } );
fbcc39ad 2162
197bd788 2163 $proto->_plugins->{$plugin} = 1;
836e1134 2164 unless ($instant) {
fbcc39ad 2165 no strict 'refs';
2166 unshift @{"$class\::ISA"}, $plugin;
2167 }
836e1134 2168 return $class;
2169 }
2170
2171 sub setup_plugins {
2172 my ( $class, $plugins ) = @_;
2173
d0d4d785 2174 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2175 $plugins ||= [];
2176 for my $plugin ( reverse @$plugins ) {
2177
2178 unless ( $plugin =~ s/\A\+// ) {
2179 $plugin = "Catalyst::Plugin::$plugin";
2180 }
2181
2182 $class->_register_plugin($plugin);
2183 }
fbcc39ad 2184 }
2185}
2186
b5ecfcf0 2187=head2 $c->stack
8767c5a3 2188
86418559 2189Returns an arrayref of the internal execution stack (actions that are
2190currently executing).
8767c5a3 2191
b5ecfcf0 2192=head2 $c->write( $data )
fbcc39ad 2193
ae1e6b59 2194Writes $data to the output stream. When using this method directly, you
2195will need to manually set the C<Content-Length> header to the length of
2196your output data, if known.
fbcc39ad 2197
2198=cut
2199
4f5ebacd 2200sub write {
2201 my $c = shift;
2202
2203 # Finalize headers if someone manually writes output
2204 $c->finalize_headers;
2205
2206 return $c->engine->write( $c, @_ );
2207}
fbcc39ad 2208
b5ecfcf0 2209=head2 version
bf88a181 2210
ae1e6b59 2211Returns the Catalyst version number. Mostly useful for "powered by"
2212messages in template systems.
bf88a181 2213
2214=cut
2215
2216sub version { return $Catalyst::VERSION }
2217
b0bb11ec 2218=head1 INTERNAL ACTIONS
2219
ae1e6b59 2220Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2221C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2222action table, but you can make them visible with a config parameter.
b0bb11ec 2223
2224 MyApp->config->{show_internal_actions} = 1;
2225
d2ee9760 2226=head1 CASE SENSITIVITY
2227
3e705254 2228By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2229mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2230parameter.
d2ee9760 2231
2232 MyApp->config->{case_sensitive} = 1;
2233
3e705254 2234This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2235
2236=head1 ON-DEMAND PARSER
2237
2238The request body is usually parsed at the beginning of a request,
3e705254 2239but if you want to handle input yourself or speed things up a bit,
fbcc39ad 2240you can enable on-demand parsing with a config parameter.
2241
2242 MyApp->config->{parse_on_demand} = 1;
2243
2244=head1 PROXY SUPPORT
2245
ae1e6b59 2246Many production servers operate using the common double-server approach,
2247with a lightweight frontend web server passing requests to a larger
2248backend server. An application running on the backend server must deal
2249with two problems: the remote user always appears to be C<127.0.0.1> and
2250the server's hostname will appear to be C<localhost> regardless of the
2251virtual host that the user connected through.
fbcc39ad 2252
ae1e6b59 2253Catalyst will automatically detect this situation when you are running
2254the frontend and backend servers on the same machine. The following
2255changes are made to the request.
fbcc39ad 2256
ae1e6b59 2257 $c->req->address is set to the user's real IP address, as read from
2258 the HTTP X-Forwarded-For header.
fbcc39ad 2259
ae1e6b59 2260 The host value for $c->req->base and $c->req->uri is set to the real
2261 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2262
3e705254 2263Obviously, your web server must support these headers for this to work.
fbcc39ad 2264
ae1e6b59 2265In a more complex server farm environment where you may have your
2266frontend proxy server(s) on different machines, you will need to set a
2267configuration option to tell Catalyst to read the proxied data from the
2268headers.
fbcc39ad 2269
2270 MyApp->config->{using_frontend_proxy} = 1;
2271
2272If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2273
fbcc39ad 2274 MyApp->config->{ignore_frontend_proxy} = 1;
2275
2276=head1 THREAD SAFETY
2277
86418559 2278Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2279C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2280believe the Catalyst core to be thread-safe.
fbcc39ad 2281
2282If you plan to operate in a threaded environment, remember that all other
3e705254 2283modules you are using must also be thread-safe. Some modules, most notably
2284L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2285
3cb1db8c 2286=head1 SUPPORT
2287
2288IRC:
2289
4eaf7c88 2290 Join #catalyst on irc.perl.org.
3cb1db8c 2291
3e705254 2292Mailing Lists:
3cb1db8c 2293
2294 http://lists.rawmode.org/mailman/listinfo/catalyst
2295 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 2296
432d507d 2297Web:
2298
2299 http://catalyst.perl.org
2300
0ef52a96 2301Wiki:
2302
2303 http://dev.catalyst.perl.org
2304
fc7ec1d9 2305=head1 SEE ALSO
2306
829a28ca 2307=head2 L<Task::Catalyst> - All you need to start with Catalyst
2308
b5ecfcf0 2309=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2310
b5ecfcf0 2311=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2312
b5ecfcf0 2313=head2 L<Catalyst::Engine> - Core engine
61b1e958 2314
b5ecfcf0 2315=head2 L<Catalyst::Log> - Log class.
61b1e958 2316
b5ecfcf0 2317=head2 L<Catalyst::Request> - Request object
61b1e958 2318
b5ecfcf0 2319=head2 L<Catalyst::Response> - Response object
61b1e958 2320
b5ecfcf0 2321=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2322
15f0b5b7 2323=head1 CREDITS
fc7ec1d9 2324
15f0b5b7 2325Andy Grundman
2326
fbcc39ad 2327Andy Wardley
2328
33108eaf 2329Andreas Marienborg
2330
f4a57de4 2331Andrew Bramble
2332
15f0b5b7 2333Andrew Ford
2334
2335Andrew Ruthven
2336
fbcc39ad 2337Arthur Bergman
2338
15f0b5b7 2339Autrijus Tang
2340
0cf56dbc 2341Brian Cassidy
2342
6aaa1c60 2343Carl Franks
2344
15f0b5b7 2345Christian Hansen
2346
2347Christopher Hicks
2348
2349Dan Sully
2350
2351Danijel Milicevic
2352
0ef52a96 2353David Kamholz
2354
15f0b5b7 2355David Naughton
2356
61bef238 2357Drew Taylor
2358
15f0b5b7 2359Gary Ashton Jones
2360
2361Geoff Richards
2362
2363Jesse Sheidlower
2364
fbcc39ad 2365Jesse Vincent
2366
15f0b5b7 2367Jody Belka
2368
2369Johan Lindstrom
2370
2371Juan Camacho
2372
2373Leon Brocard
2374
2375Marcus Ramberg
2376
2377Matt S Trout
2378
71c3bcc3 2379Robert Sedlacek
2380
a727119f 2381Sam Vilain
2382
1cf1c56a 2383Sascha Kiefer
2384
15f0b5b7 2385Tatsuhiko Miyagawa
fc7ec1d9 2386
51f0308d 2387Ulf Edvinsson
2388
bdcb95ef 2389Yuval Kogman
2390
51f0308d 2391=head1 AUTHOR
2392
2393Sebastian Riedel, C<sri@oook.de>
2394
fc7ec1d9 2395=head1 LICENSE
2396
9ce5ab63 2397This library is free software, you can redistribute it and/or modify it under
41ca9ba7 2398the same terms as Perl itself.
fc7ec1d9 2399
2400=cut
2401
24021;