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