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