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