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