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