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