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