Some notes about next steps / removals
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
1 package Catalyst;
2
3 use Moose;
4 use Moose::Meta::Class ();
5 extends 'Catalyst::Component';
6 use Moose::Util qw/find_meta/;
7 use B::Hooks::EndOfScope ();
8 use Catalyst::Exception;
9 use Catalyst::Exception::Detach;
10 use Catalyst::Exception::Go;
11 use Catalyst::Log;
12 use Catalyst::Request;
13 use Catalyst::Request::Upload;
14 use Catalyst::Response;
15 use Catalyst::Utils;
16 use Catalyst::Controller;
17 use Data::OptList;
18 use Devel::InnerPackage ();
19 use File::stat;
20 use Module::Pluggable::Object ();
21 use Text::SimpleTable ();
22 use Path::Class::Dir ();
23 use Path::Class::File ();
24 use URI ();
25 use URI::http;
26 use URI::https;
27 use Tree::Simple qw/use_weak_refs/;
28 use Tree::Simple::Visitor::FindByUID;
29 use Class::C3::Adopt::NEXT;
30 use List::Util qw/first/;
31 use List::MoreUtils qw/uniq/;
32 use attributes;
33 use utf8;
34 use Carp qw/croak carp shortmess/;
35
36 BEGIN { require 5.008004; }
37
38 has stack => (is => 'ro', default => sub { [] });
39 has stash => (is => 'rw', default => sub { {} });
40 has state => (is => 'rw', default => 0);
41 has stats => (is => 'rw');
42 has action => (is => 'rw');
43 has counter => (is => 'rw', default => sub { {} });
44 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
45 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
46 has namespace => (is => 'rw');
47
48 sub depth { scalar @{ shift->stack || [] }; }
49 sub comp { shift->component(@_) }
50
51 sub req {
52     my $self = shift; return $self->request(@_);
53 }
54 sub res {
55     my $self = shift; return $self->response(@_);
56 }
57
58 # For backwards compatibility
59 sub finalize_output { shift->finalize_body(@_) };
60
61 # For statistics
62 our $COUNT     = 1;
63 our $START     = time;
64 our $RECURSION = 1000;
65 our $DETACH    = Catalyst::Exception::Detach->new;
66 our $GO        = Catalyst::Exception::Go->new;
67
68 #I imagine that very few of these really need to be class variables. if any.
69 #maybe we should just make them attributes with a default?
70 __PACKAGE__->mk_classdata($_) # XXX FIXME - components remove from here
71   for qw/container components arguments dispatcher engine log dispatcher_class
72   engine_class context_class request_class response_class stats_class
73   setup_finished/;
74
75 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
76 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
77 __PACKAGE__->request_class('Catalyst::Request');
78 __PACKAGE__->response_class('Catalyst::Response');
79 __PACKAGE__->stats_class('Catalyst::Stats');
80
81 # Remember to update this in Catalyst::Runtime as well!
82
83 our $VERSION = '5.80032';
84
85 sub import {
86     my ( $class, @arguments ) = @_;
87
88     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
89     # callers @ISA.
90     return unless $class eq 'Catalyst';
91
92     my $caller = caller();
93     return if $caller eq 'main';
94
95     my $meta = Moose::Meta::Class->initialize($caller);
96
97     unless ( $caller->isa('Catalyst') ) { # XXX - Remove!
98         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); # XXX - Remove!
99         $meta->superclasses(@superclasses); # XXX - Remove!
100     } # XXX - Remove!
101
102     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
103     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
104
105     unless( $meta->has_method('meta') ){
106         if ($Moose::VERSION >= 1.15) {
107             $meta->_add_meta_method('meta');
108         }
109         else {
110             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
111         }
112     }
113
114     $caller->arguments( [@arguments] );
115     $caller->setup_home;
116 }
117
118 sub _application { $_[0] }
119
120 =head1 NAME
121
122 Catalyst - The Elegant MVC Web Application Framework
123
124 =head1 SYNOPSIS
125
126 See the L<Catalyst::Manual> distribution for comprehensive
127 documentation and tutorials.
128
129     # Install Catalyst::Devel for helpers and other development tools
130     # use the helper to create a new application
131     catalyst.pl MyApp
132
133     # add models, views, controllers
134     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
135     script/myapp_create.pl view MyTemplate TT
136     script/myapp_create.pl controller Search
137
138     # built in testserver -- use -r to restart automatically on changes
139     # --help to see all available options
140     script/myapp_server.pl
141
142     # command line testing interface
143     script/myapp_test.pl /yada
144
145     ### in lib/MyApp.pm
146     use Catalyst qw/-Debug/; # include plugins here as well
147
148     ### In lib/MyApp/Controller/Root.pm (autocreated)
149     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
150         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
151         $c->stash->{template} = 'foo.tt'; # set the template
152         # lookup something from db -- stash vars are passed to TT
153         $c->stash->{data} =
154           $c->model('Database::Foo')->search( { country => $args[0] } );
155         if ( $c->req->params->{bar} ) { # access GET or POST parameters
156             $c->forward( 'bar' ); # process another action
157             # do something else after forward returns
158         }
159     }
160
161     # The foo.tt TT template can use the stash data from the database
162     [% WHILE (item = data.next) %]
163         [% item.foo %]
164     [% END %]
165
166     # called for /bar/of/soap, /bar/of/soap/10, etc.
167     sub bar : Path('/bar/of/soap') { ... }
168
169     # called for all actions, from the top-most controller downwards
170     sub auto : Private {
171         my ( $self, $c ) = @_;
172         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
173             $c->res->redirect( '/login' ); # require login
174             return 0; # abort request and go immediately to end()
175         }
176         return 1; # success; carry on to next action
177     }
178
179     # called after all actions are finished
180     sub end : Private {
181         my ( $self, $c ) = @_;
182         if ( scalar @{ $c->error } ) { ... } # handle errors
183         return if $c->res->body; # already have a response
184         $c->forward( 'MyApp::View::TT' ); # render template
185     }
186
187     ### in MyApp/Controller/Foo.pm
188     # called for /foo/bar
189     sub bar : Local { ... }
190
191     # called for /blargle
192     sub blargle : Global { ... }
193
194     # an index action matches /foo, but not /foo/1, etc.
195     sub index : Private { ... }
196
197     ### in MyApp/Controller/Foo/Bar.pm
198     # called for /foo/bar/baz
199     sub baz : Local { ... }
200
201     # first Root auto is called, then Foo auto, then this
202     sub auto : Private { ... }
203
204     # powerful regular expression paths are also possible
205     sub details : Regex('^product/(\w+)/details$') {
206         my ( $self, $c ) = @_;
207         # extract the (\w+) from the URI
208         my $product = $c->req->captures->[0];
209     }
210
211 See L<Catalyst::Manual::Intro> for additional information.
212
213 =head1 DESCRIPTION
214
215 Catalyst is a modern framework for making web applications without the
216 pain usually associated with this process. This document is a reference
217 to the main Catalyst application. If you are a new user, we suggest you
218 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
219
220 See L<Catalyst::Manual> for more documentation.
221
222 Catalyst plugins can be loaded by naming them as arguments to the "use
223 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
224 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
225 C<My::Module>.
226
227     use Catalyst qw/My::Module/;
228
229 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
230 fully qualify the name by using a unary plus:
231
232     use Catalyst qw/
233         My::Module
234         +Fully::Qualified::Plugin::Name
235     /;
236
237 Special flags like C<-Debug> and C<-Engine> can also be specified as
238 arguments when Catalyst is loaded:
239
240     use Catalyst qw/-Debug My::Module/;
241
242 The position of plugins and flags in the chain is important, because
243 they are loaded in the order in which they appear.
244
245 The following flags are supported:
246
247 =head2 -Debug
248
249 Enables debug output. You can also force this setting from the system
250 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
251 settings override the application, with <MYAPP>_DEBUG having the highest
252 priority.
253
254 This sets the log level to 'debug' and enables full debug output on the
255 error screen. If you only want the latter, see L<< $c->debug >>.
256
257 =head2 -Engine
258
259 Forces Catalyst to use a specific engine. Omit the
260 C<Catalyst::Engine::> prefix of the engine name, i.e.:
261
262     use Catalyst qw/-Engine=CGI/;
263
264 =head2 -Home
265
266 Forces Catalyst to use a specific home directory, e.g.:
267
268     use Catalyst qw[-Home=/usr/mst];
269
270 This can also be done in the shell environment by setting either the
271 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
272 is replaced with the uppercased name of your application, any "::" in
273 the name will be replaced with underscores, e.g. MyApp::Web should use
274 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
275
276 If none of these are set, Catalyst will attempt to automatically detect the
277 home directory. If you are working in a development envirnoment, Catalyst
278 will try and find the directory containing either Makefile.PL, Build.PL or
279 dist.ini. If the application has been installed into the system (i.e.
280 you have done C<make install>), then Catalyst will use the path to your
281 application module, without the .pm extension (ie, /foo/MyApp if your
282 application was installed at /foo/MyApp.pm)
283
284 =head2 -Log
285
286     use Catalyst '-Log=warn,fatal,error';
287
288 Specifies a comma-delimited list of log levels.
289
290 =head2 -Stats
291
292 Enables statistics collection and reporting.
293
294    use Catalyst qw/-Stats=1/;
295
296 You can also force this setting from the system environment with CATALYST_STATS
297 or <MYAPP>_STATS. The environment settings override the application, with
298 <MYAPP>_STATS having the highest priority.
299
300 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
301
302 =head1 METHODS
303
304 =head2 INFORMATION ABOUT THE CURRENT REQUEST
305
306 =head2 $c->action
307
308 Returns a L<Catalyst::Action> object for the current action, which
309 stringifies to the action name. See L<Catalyst::Action>.
310
311 =head2 $c->namespace
312
313 Returns the namespace of the current action, i.e., the URI prefix
314 corresponding to the controller of the current action. For example:
315
316     # in Controller::Foo::Bar
317     $c->namespace; # returns 'foo/bar';
318
319 =head2 $c->request
320
321 =head2 $c->req
322
323 Returns the current L<Catalyst::Request> object, giving access to
324 information about the current client request (including parameters,
325 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
326
327 =head2 REQUEST FLOW HANDLING
328
329 =head2 $c->forward( $action [, \@arguments ] )
330
331 =head2 $c->forward( $class, $method, [, \@arguments ] )
332
333 Forwards processing to another action, by its private name. If you give a
334 class name but no method, C<process()> is called. You may also optionally
335 pass arguments in an arrayref. The action will receive the arguments in
336 C<@_> and C<< $c->req->args >>. Upon returning from the function,
337 C<< $c->req->args >> will be restored to the previous values.
338
339 Any data C<return>ed from the action forwarded to, will be returned by the
340 call to forward.
341
342     my $foodata = $c->forward('/foo');
343     $c->forward('index');
344     $c->forward(qw/Model::DBIC::Foo do_stuff/);
345     $c->forward('View::TT');
346
347 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
348 an C<< eval { } >> around the call (actually
349 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
350 all 'dies' within the called action. If you want C<die> to propagate you
351 need to do something like:
352
353     $c->forward('foo');
354     die join "\n", @{ $c->error } if @{ $c->error };
355
356 Or make sure to always return true values from your actions and write
357 your code like this:
358
359     $c->forward('foo') || return;
360
361 Another note is that C<< $c->forward >> always returns a scalar because it
362 actually returns $c->state which operates in a scalar context.
363 Thus, something like:
364
365     return @array;
366
367 in an action that is forwarded to is going to return a scalar,
368 i.e. how many items are in that array, which is probably not what you want.
369 If you need to return an array then return a reference to it,
370 or stash it like so:
371
372     $c->stash->{array} = \@array;
373
374 and access it from the stash.
375
376 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
377
378 =cut
379
380 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
381
382 =head2 $c->detach( $action [, \@arguments ] )
383
384 =head2 $c->detach( $class, $method, [, \@arguments ] )
385
386 =head2 $c->detach()
387
388 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
389 doesn't return to the previous action when processing is finished.
390
391 When called with no arguments it escapes the processing chain entirely.
392
393 =cut
394
395 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
396
397 =head2 $c->visit( $action [, \@captures, \@arguments ] )
398
399 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
400
401 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
402 but does a full dispatch, instead of just calling the new C<$action> /
403 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
404 you go to are called, just like a new request.
405
406 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
407 This means, for example, that C<< $c->action >> methods such as
408 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
409 L<reverse|Catalyst::Action/reverse> return information for the visited action
410 when they are invoked within the visited action.  This is different from the
411 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
412 continues to use the $c->action object from the caller action even when
413 invoked from the callee.
414
415 C<< $c->stash >> is kept unchanged.
416
417 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
418 allows you to "wrap" another action, just as it would have been called by
419 dispatching from a URL, while the analogous
420 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
421 transfer control to another action as if it had been reached directly from a URL.
422
423 =cut
424
425 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
426
427 =head2 $c->go( $action [, \@captures, \@arguments ] )
428
429 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
430
431 The relationship between C<go> and
432 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
433 the relationship between
434 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
435 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
436 C<< $c->go >> will perform a full dispatch on the specified action or method,
437 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
438 C<go> escapes the processing of the current request chain on completion, and
439 does not return to its caller.
440
441 @arguments are arguments to the final destination of $action. @captures are
442 arguments to the intermediate steps, if any, on the way to the final sub of
443 $action.
444
445 =cut
446
447 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
448
449 =head2 $c->response
450
451 =head2 $c->res
452
453 Returns the current L<Catalyst::Response> object, see there for details.
454
455 =head2 $c->stash
456
457 Returns a hashref to the stash, which may be used to store data and pass
458 it between components during a request. You can also set hash keys by
459 passing arguments. The stash is automatically sent to the view. The
460 stash is cleared at the end of a request; it cannot be used for
461 persistent storage (for this you must use a session; see
462 L<Catalyst::Plugin::Session> for a complete system integrated with
463 Catalyst).
464
465     $c->stash->{foo} = $bar;
466     $c->stash( { moose => 'majestic', qux => 0 } );
467     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
468
469     # stash is automatically passed to the view for use in a template
470     $c->forward( 'MyApp::View::TT' );
471
472 =cut
473
474 around stash => sub {
475     my $orig = shift;
476     my $c = shift;
477     my $stash = $orig->($c);
478     if (@_) {
479         my $new_stash = @_ > 1 ? {@_} : $_[0];
480         croak('stash takes a hash or hashref') unless ref $new_stash;
481         foreach my $key ( keys %$new_stash ) {
482           $stash->{$key} = $new_stash->{$key};
483         }
484     }
485
486     return $stash;
487 };
488
489
490 =head2 $c->error
491
492 =head2 $c->error($error, ...)
493
494 =head2 $c->error($arrayref)
495
496 Returns an arrayref containing error messages.  If Catalyst encounters an
497 error while processing a request, it stores the error in $c->error.  This
498 method should only be used to store fatal error messages.
499
500     my @error = @{ $c->error };
501
502 Add a new error.
503
504     $c->error('Something bad happened');
505
506 =cut
507
508 sub error {
509     my $c = shift;
510     if ( $_[0] ) {
511         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
512         croak @$error unless ref $c;
513         push @{ $c->{error} }, @$error;
514     }
515     elsif ( defined $_[0] ) { $c->{error} = undef }
516     return $c->{error} || [];
517 }
518
519
520 =head2 $c->state
521
522 Contains the return value of the last executed action.
523 Note that << $c->state >> operates in a scalar context which means that all
524 values it returns are scalar.
525
526 =head2 $c->clear_errors
527
528 Clear errors.  You probably don't want to clear the errors unless you are
529 implementing a custom error screen.
530
531 This is equivalent to running
532
533     $c->error(0);
534
535 =cut
536
537 sub clear_errors {
538     my $c = shift;
539     $c->error(0);
540 }
541
542 =head2 COMPONENT ACCESSORS
543
544 =head2 $c->controller($name)
545
546 Gets a L<Catalyst::Controller> instance by name.
547
548     $c->controller('Foo')->do_stuff;
549
550 If the name is omitted, will return the controller for the dispatched
551 action.
552
553 If you want to search for controllers, pass in a regexp as the argument.
554
555     # find all controllers that start with Foo
556     my @foo_controllers = $c->controller(qr{^Foo});
557
558
559 =cut
560
561 sub controller {
562     my ( $c, $name, @args ) = @_;
563
564 # FIXME: should this be a Catalyst::Utils method?
565     if (!$name) {
566         my $class  = $c->action->class;
567
568         my $prefix = length Catalyst::Utils::class2classprefix($class);
569
570         # MyApp::Controller::Foo becomes Foo
571         # the + 2 is because of the ::
572         $name = substr $class, $prefix + 2;
573     }
574
575     return $c->container->get_component_from_sub_container( 'controller', $name, $c, @args);
576 }
577
578 =head2 $c->model($name)
579
580 Gets a L<Catalyst::Model> instance by name.
581
582     $c->model('Foo')->do_stuff;
583
584 Any extra arguments are directly passed to ACCEPT_CONTEXT.
585
586 If the name is omitted, it will look for
587  - a model object in $c->stash->{current_model_instance}, then
588  - a model name in $c->stash->{current_model}, then
589  - a config setting 'default_model', or
590  - check if there is only one model, and return it if that's the case.
591
592 If you want to search for models, pass in a regexp as the argument.
593
594     # find all models that start with Foo
595     my @foo_models = $c->model(qr{^Foo});
596
597 =cut
598
599 sub model {
600     my ( $c, $name, @args ) = @_;
601
602     if (ref $c && !$name) {
603         return $c->stash->{current_model_instance}
604             if $c->stash->{current_model_instance};
605
606         $name = $c->stash->{current_model}
607             if $c->stash->{current_model};
608     }
609
610     return $c->container->get_component_from_sub_container( 'model', $name, $c, @args);
611 }
612
613
614 =head2 $c->view($name)
615
616 Gets a L<Catalyst::View> instance by name.
617
618     $c->view('Foo')->do_stuff;
619
620 Any extra arguments are directly passed to ACCEPT_CONTEXT.
621
622 If the name is omitted, it will look for
623  - a view object in $c->stash->{current_view_instance}, then
624  - a view name in $c->stash->{current_view}, then
625  - a config setting 'default_view', or
626  - check if there is only one view, and return it if that's the case.
627
628 If you want to search for views, pass in a regexp as the argument.
629
630     # find all views that start with Foo
631     my @foo_views = $c->view(qr{^Foo});
632
633 =cut
634
635 sub view {
636     my ( $c, $name, @args ) = @_;
637
638     if (ref $c && !$name) {
639         return $c->stash->{current_view_instance}
640             if $c->stash->{current_view_instance};
641
642         $name = $c->stash->{current_view}
643             if $c->stash->{current_view};
644     }
645
646     return $c->container->get_component_from_sub_container( 'view', $name, $c, @args);
647 }
648
649 =head2 $c->controllers
650
651 Returns the available names which can be passed to $c->controller
652
653 =cut
654
655 sub controllers {
656     my ( $c ) = @_;
657     return $c->container->get_sub_container('controller')->get_service_list;
658 }
659
660 =head2 $c->models
661
662 Returns the available names which can be passed to $c->model
663
664 =cut
665
666 sub models {
667     my ( $c ) = @_;
668     return $c->container->get_sub_container('model')->get_service_list;
669 }
670
671
672 =head2 $c->views
673
674 Returns the available names which can be passed to $c->view
675
676 =cut
677
678 sub views {
679     my ( $c ) = @_;
680     return $c->container->get_sub_container('view')->get_service_list;
681 }
682
683 sub _find_component {
684     my ($c, $component, @args) = @_;
685     my @result;
686
687     my $query = ref $component
688               ? $component
689               : qr{^$component$}
690               ;
691
692     for my $subcontainer_name (qw/model view controller/) {
693         my $subcontainer = $c->container->get_sub_container($subcontainer_name);
694         my @components   = $subcontainer->get_service_list;
695         @result          = grep { m{$component} } @components;
696
697         return map { $subcontainer->get_component( $_, $c, @args ) } @result
698             if @result;
699     }
700
701     # it expects an empty list on failed searches
702     return @result;
703 }
704
705 =head2 $c->comp($name)
706
707 =head2 $c->component($name)
708
709 Gets a component object by name. This method is not recommended,
710 unless you want to get a specific component by full
711 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
712 should be used instead.
713
714 If C<$name> is a regexp, a list of components matched against the full
715 component name will be returned.
716
717 =cut
718
719 sub component {
720     my ( $c, $component, @args ) = @_;
721
722     return sort keys %{ $c->components }
723         unless $component;
724
725     my ($type, $name) = _get_component_type_name($component);
726
727     return $c->container->get_component_from_sub_container(
728         $type, $name, $c, @args
729     ) if $type;
730
731     my @result = $c->_find_component( $component, @args );
732
733     # list context for regexp searches
734     return @result if ref $component;
735
736     # only one component (if it's found) for string searches
737     return shift @result if @result;
738
739     # FIXME: I probably shouldn't be doing this
740     # I'm keeping it temporarily for things like $c->comp('MyApp')
741     return $c->components->{$component}
742         if exists $c->components->{$component} and !@args;
743
744     $c->log->warn("Looking for '$component', but nothing was found.");
745
746     # I would expect to return an empty list here, but that breaks back-compat
747     $c->log->warn("Component not found, returning the list of existing");
748     $c->log->warn("components. This behavior is going to be deprecated");
749     $c->log->warn("in future releases.");
750
751     return sort keys %{ $c->components };
752 }
753
754 =head2 CLASS DATA AND HELPER CLASSES
755
756 =head2 $c->config
757
758 Returns or takes a hashref containing the application's configuration.
759
760     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
761
762 You can also use a C<YAML>, C<XML> or L<Config::General> config file
763 like C<myapp.conf> in your applications home directory. See
764 L<Catalyst::Plugin::ConfigLoader>.
765
766 =head3 Cascading configuration
767
768 The config method is present on all Catalyst components, and configuration
769 will be merged when an application is started. Configuration loaded with
770 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
771 followed by configuration in your top level C<MyApp> class. These two
772 configurations are merged, and then configuration data whose hash key matches a
773 component name is merged with configuration for that component.
774
775 The configuration for a component is then passed to the C<new> method when a
776 component is constructed.
777
778 For example:
779
780     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
781     MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
782
783 will mean that C<MyApp::Model::Foo> receives the following data when
784 constructed:
785
786     MyApp::Model::Foo->new({
787         bar => 'baz',
788         quux => 'frob',
789         overrides => 'me',
790     });
791
792 It's common practice to use a Moose attribute
793 on the receiving component to access the config value.
794
795     package MyApp::Model::Foo;
796
797     use Moose;
798
799     # this attr will receive 'baz' at construction time
800     has 'bar' => (
801         is  => 'rw',
802         isa => 'Str',
803     );
804
805 You can then get the value 'baz' by calling $c->model('Foo')->bar
806 (or $self->bar inside code in the model).
807
808 B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
809 as a way of reading config within your code, as this B<will not> give you the
810 correctly merged config back. You B<MUST> take the config values supplied to
811 the constructor and use those instead.
812
813 =cut
814
815 around config => sub {
816     my $orig = shift;
817     my $c = shift;
818
819     croak('Setting config after setup has been run is not allowed.')
820         if ( @_ and $c->setup_finished );
821
822     $c->$orig(@_);
823 };
824
825 =head2 $c->log
826
827 Returns the logging object instance. Unless it is already set, Catalyst
828 sets this up with a L<Catalyst::Log> object. To use your own log class,
829 set the logger with the C<< __PACKAGE__->log >> method prior to calling
830 C<< __PACKAGE__->setup >>.
831
832  __PACKAGE__->log( MyLogger->new );
833  __PACKAGE__->setup;
834
835 And later:
836
837     $c->log->info( 'Now logging with my own logger!' );
838
839 Your log class should implement the methods described in
840 L<Catalyst::Log>.
841
842
843 =head2 $c->debug
844
845 Returns 1 if debug mode is enabled, 0 otherwise.
846
847 You can enable debug mode in several ways:
848
849 =over
850
851 =item By calling myapp_server.pl with the -d flag
852
853 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
854
855 =item The -Debug option in your MyApp.pm
856
857 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
858
859 =back
860
861 The first three also set the log level to 'debug'.
862
863 Calling C<< $c->debug(1) >> has no effect.
864
865 =cut
866
867 sub debug { 0 }
868
869 =head2 $c->dispatcher
870
871 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
872
873 =head2 $c->engine
874
875 Returns the engine instance. See L<Catalyst::Engine>.
876
877
878 =head2 UTILITY METHODS
879
880 =head2 $c->path_to(@path)
881
882 Merges C<@path> with C<< $c->config->{home} >> and returns a
883 L<Path::Class::Dir> object. Note you can usually use this object as
884 a filename, but sometimes you will have to explicitly stringify it
885 yourself by calling the C<< ->stringify >> method.
886
887 For example:
888
889     $c->path_to( 'db', 'sqlite.db' );
890
891 =cut
892
893 sub path_to {
894     my ( $c, @path ) = @_;
895     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
896     if ( -d $path ) { return $path }
897     else { return Path::Class::File->new( $c->config->{home}, @path ) }
898 }
899
900 =head2 $c->plugin( $name, $class, @args )
901
902 Helper method for plugins. It creates a class data accessor/mutator and
903 loads and instantiates the given class.
904
905     MyApp->plugin( 'prototype', 'HTML::Prototype' );
906
907     $c->prototype->define_javascript_functions;
908
909 B<Note:> This method of adding plugins is deprecated. The ability
910 to add plugins like this B<will be removed> in a Catalyst 5.81.
911 Please do not use this functionality in new code.
912
913 =cut
914
915 sub plugin {
916     my ( $class, $name, $plugin, @args ) = @_;
917
918     # See block comment in t/aggregate/unit_core_plugin.t
919     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
920
921     $class->_register_plugin( $plugin, 1 );
922
923     eval { $plugin->import };
924     $class->mk_classdata($name);
925     my $obj;
926     eval { $obj = $plugin->new(@args) };
927
928     if ($@) {
929         Catalyst::Exception->throw( message =>
930               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
931     }
932
933     $class->$name($obj);
934     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
935       if $class->debug;
936 }
937
938 =head2 MyApp->setup
939
940 Initializes the dispatcher and engine, loads any plugins, and loads the
941 model, view, and controller components. You may also specify an array
942 of plugins to load here, if you choose to not load them in the C<use
943 Catalyst> line.
944
945     MyApp->setup;
946     MyApp->setup( qw/-Debug/ );
947
948 =cut
949
950 sub setup {
951     my ( $class, @arguments ) = @_;
952     croak('Running setup more than once')
953         if ( $class->setup_finished );
954
955     unless ( $class->isa('Catalyst') ) {
956
957         Catalyst::Exception->throw(
958             message => qq/'$class' does not inherit from Catalyst/ );
959     }
960
961     if ( $class->arguments ) {
962         @arguments = ( @arguments, @{ $class->arguments } );
963     }
964
965     # Process options
966     my $flags = {};
967
968     foreach (@arguments) {
969
970         if (/^-Debug$/) {
971             $flags->{log} =
972               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
973         }
974         elsif (/^-(\w+)=?(.*)$/) {
975             $flags->{ lc $1 } = $2;
976         }
977         else {
978             push @{ $flags->{plugins} }, $_;
979         }
980     }
981
982     $class->setup_config();
983     $class->setup_home( delete $flags->{home} );
984
985     $class->setup_log( delete $flags->{log} );
986     $class->setup_plugins( delete $flags->{plugins} );
987     $class->setup_dispatcher( delete $flags->{dispatcher} );
988     $class->setup_engine( delete $flags->{engine} );
989     $class->setup_stats( delete $flags->{stats} );
990
991     for my $flag ( sort keys %{$flags} ) {
992
993         if ( my $code = $class->can( 'setup_' . $flag ) ) {
994             &$code( $class, delete $flags->{$flag} );
995         }
996         else {
997             $class->log->warn(qq/Unknown flag "$flag"/);
998         }
999     }
1000
1001     eval { require Catalyst::Devel; };
1002     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1003         $class->log->warn(<<"EOF");
1004 You are running an old script!
1005
1006   Please update by running (this will overwrite existing files):
1007     catalyst.pl -force -scripts $class
1008
1009   or (this will not overwrite existing files):
1010     catalyst.pl -scripts $class
1011
1012 EOF
1013     }
1014
1015     if ( $class->debug ) {
1016         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1017
1018         if (@plugins) {
1019             my $column_width = Catalyst::Utils::term_width() - 6;
1020             my $t = Text::SimpleTable->new($column_width);
1021             $t->row($_) for @plugins;
1022             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1023         }
1024
1025         my $dispatcher = $class->dispatcher;
1026         my $engine     = $class->engine;
1027         my $home       = $class->config->{home};
1028
1029         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1030         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1031
1032         $home
1033           ? ( -d $home )
1034           ? $class->log->debug(qq/Found home "$home"/)
1035           : $class->log->debug(qq/Home "$home" doesn't exist/)
1036           : $class->log->debug(q/Couldn't find home/);
1037     }
1038
1039     # Call plugins setup, this is stupid and evil.
1040     # Also screws C3 badly on 5.10, hack to avoid.
1041     {
1042         no warnings qw/redefine/;
1043         local *setup = sub { };
1044         $class->setup unless $Catalyst::__AM_RESTARTING;
1045     }
1046
1047     # Initialize our data structure
1048     $class->components( {} ); # XXX - Remove!
1049
1050     $class->setup_components;
1051
1052     if ( $class->debug ) { # XXX - Fixme to be a method on the container? (Or at least get a) data structure back from the container!!
1053         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1054         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1055         for my $comp ( sort keys %{ $class->components } ) {
1056             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1057             $t->row( $comp, $type );
1058         }
1059         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1060           if ( keys %{ $class->components } );
1061     }
1062
1063     # Add our self to components, since we are also a component
1064     if( $class->isa('Catalyst::Controller') ){
1065       $class->components->{$class} = $class;
1066     }
1067
1068     $class->setup_actions;
1069
1070     if ( $class->debug ) {
1071         my $name = $class->config->{name} || 'Application';
1072         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1073     }
1074
1075     # Make sure that the application class becomes immutable at this point,
1076     B::Hooks::EndOfScope::on_scope_end {
1077         return if $@;
1078         my $meta = Class::MOP::get_metaclass_by_name($class);
1079         if (
1080             $meta->is_immutable
1081             && ! { $meta->immutable_options }->{replace_constructor}
1082             && (
1083                    $class->isa('Class::Accessor::Fast')
1084                 || $class->isa('Class::Accessor')
1085             )
1086         ) {
1087             warn "You made your application class ($class) immutable, "
1088                 . "but did not inline the\nconstructor. "
1089                 . "This will break catalyst, as your app \@ISA "
1090                 . "Class::Accessor(::Fast)?\nPlease pass "
1091                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1092         }
1093         $meta->make_immutable(
1094             replace_constructor => 1,
1095         ) unless $meta->is_immutable;
1096     };
1097
1098     if ($class->config->{case_sensitive}) {
1099         $class->log->warn($class . "->config->{case_sensitive} is set.");
1100         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1101     }
1102
1103     $class->setup_finalize;
1104     # Should be the last thing we do so that user things hooking
1105     # setup_finalize can log..
1106     $class->log->_flush() if $class->log->can('_flush');
1107     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
1108 }
1109
1110 =head2 $app->setup_finalize
1111
1112 A hook to attach modifiers to. This method does not do anything except set the
1113 C<setup_finished> accessor.
1114
1115 Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
1116
1117 Example:
1118
1119     after setup_finalize => sub {
1120         my $app = shift;
1121
1122         ## do stuff here..
1123     };
1124
1125 =cut
1126
1127 sub setup_finalize {
1128     my ($class) = @_;
1129     $class->setup_finished(1);
1130 }
1131
1132 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1133
1134 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1135
1136 Constructs an absolute L<URI> object based on the application root, the
1137 provided path, and the additional arguments and query parameters provided.
1138 When used as a string, provides a textual URI.  If you need more flexibility
1139 than this (i.e. the option to provide relative URIs etc.) see
1140 L<Catalyst::Plugin::SmartURI>.
1141
1142 If no arguments are provided, the URI for the current action is returned.
1143 To return the current action and also provide @args, use
1144 C<< $c->uri_for( $c->action, @args ) >>.
1145
1146 If the first argument is a string, it is taken as a public URI path relative
1147 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1148 relative to the application root (if it does). It is then merged with
1149 C<< $c->request->base >>; any C<@args> are appended as additional path
1150 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1151
1152 If the first argument is a L<Catalyst::Action> it represents an action which
1153 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1154 optional C<\@captures> argument (an arrayref) allows passing the captured
1155 variables that are needed to fill in the paths of Chained and Regex actions;
1156 once the path is resolved, C<uri_for> continues as though a path was
1157 provided, appending any arguments or parameters and creating an absolute
1158 URI.
1159
1160 The captures for the current request can be found in
1161 C<< $c->request->captures >>, and actions can be resolved using
1162 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1163 path, use C<< $c->uri_for_action >> instead.
1164
1165   # Equivalent to $c->req->uri
1166   $c->uri_for($c->action, $c->req->captures,
1167       @{ $c->req->args }, $c->req->params);
1168
1169   # For the Foo action in the Bar controller
1170   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1171
1172   # Path to a static resource
1173   $c->uri_for('/static/images/logo.png');
1174
1175 =cut
1176
1177 sub uri_for {
1178     my ( $c, $path, @args ) = @_;
1179
1180     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1181         $path = $path->path_prefix;
1182         $path =~ s{/+\z}{};
1183         $path .= '/';
1184     }
1185
1186     undef($path) if (defined $path && $path eq '');
1187
1188     my $params =
1189       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1190
1191     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1192     foreach my $arg (@args) {
1193         utf8::encode($arg) if utf8::is_utf8($arg);
1194         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1195     }
1196
1197     if ( blessed($path) ) { # action object
1198         s|/|%2F|g for @args;
1199         my $captures = [ map { s|/|%2F|g; $_; }
1200                         ( scalar @args && ref $args[0] eq 'ARRAY'
1201                          ? @{ shift(@args) }
1202                          : ()) ];
1203
1204         foreach my $capture (@$captures) {
1205             utf8::encode($capture) if utf8::is_utf8($capture);
1206             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1207         }
1208
1209         my $action = $path;
1210         $path = $c->dispatcher->uri_for_action($action, $captures);
1211         if (not defined $path) {
1212             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1213                 if $c->debug;
1214             return undef;
1215         }
1216         $path = '/' if $path eq '';
1217     }
1218
1219     unshift(@args, $path);
1220
1221     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1222         my $namespace = $c->namespace;
1223         if (defined $path) { # cheesy hack to handle path '../foo'
1224            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1225         }
1226         unshift(@args, $namespace || '');
1227     }
1228
1229     # join args with '/', or a blank string
1230     my $args = join('/', grep { defined($_) } @args);
1231     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1232     $args =~ s!^/+!!;
1233     my $base = $c->req->base;
1234     my $class = ref($base);
1235     $base =~ s{(?<!/)$}{/};
1236
1237     my $query = '';
1238
1239     if (my @keys = keys %$params) {
1240       # somewhat lifted from URI::_query's query_form
1241       $query = '?'.join('&', map {
1242           my $val = $params->{$_};
1243           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1244           s/ /+/g;
1245           my $key = $_;
1246           $val = '' unless defined $val;
1247           (map {
1248               my $param = "$_";
1249               utf8::encode( $param ) if utf8::is_utf8($param);
1250               # using the URI::Escape pattern here so utf8 chars survive
1251               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1252               $param =~ s/ /+/g;
1253               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1254       } @keys);
1255     }
1256
1257     my $res = bless(\"${base}${args}${query}", $class);
1258     $res;
1259 }
1260
1261 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1262
1263 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1264
1265 =over
1266
1267 =item $path
1268
1269 A private path to the Catalyst action you want to create a URI for.
1270
1271 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1272 >> and passing the resulting C<$action> and the remaining arguments to C<<
1273 $c->uri_for >>.
1274
1275 You can also pass in a Catalyst::Action object, in which case it is passed to
1276 C<< $c->uri_for >>.
1277
1278 Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action.
1279
1280 For example, if the action looks like:
1281
1282  package MyApp::Controller::Users;
1283
1284  sub lst : Path('the-list') {}
1285
1286 You can use:
1287
1288  $c->uri_for_action('/users/lst')
1289
1290 and it will create the URI /users/the-list.
1291
1292 =back
1293
1294 =cut
1295
1296 sub uri_for_action {
1297     my ( $c, $path, @args ) = @_;
1298     my $action = blessed($path)
1299       ? $path
1300       : $c->dispatcher->get_action_by_path($path);
1301     unless (defined $action) {
1302       croak "Can't find action for path '$path'";
1303     }
1304     return $c->uri_for( $action, @args );
1305 }
1306
1307 =head2 $c->welcome_message
1308
1309 Returns the Catalyst welcome HTML page.
1310
1311 =cut
1312
1313 sub welcome_message {
1314     my $c      = shift;
1315     my $name   = $c->config->{name};
1316     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1317     my $prefix = Catalyst::Utils::appprefix( ref $c );
1318     $c->response->content_type('text/html; charset=utf-8');
1319     return <<"EOF";
1320 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1321     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1322 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1323     <head>
1324     <meta http-equiv="Content-Language" content="en" />
1325     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1326         <title>$name on Catalyst $VERSION</title>
1327         <style type="text/css">
1328             body {
1329                 color: #000;
1330                 background-color: #eee;
1331             }
1332             div#content {
1333                 width: 640px;
1334                 margin-left: auto;
1335                 margin-right: auto;
1336                 margin-top: 10px;
1337                 margin-bottom: 10px;
1338                 text-align: left;
1339                 background-color: #ccc;
1340                 border: 1px solid #aaa;
1341             }
1342             p, h1, h2 {
1343                 margin-left: 20px;
1344                 margin-right: 20px;
1345                 font-family: verdana, tahoma, sans-serif;
1346             }
1347             a {
1348                 font-family: verdana, tahoma, sans-serif;
1349             }
1350             :link, :visited {
1351                     text-decoration: none;
1352                     color: #b00;
1353                     border-bottom: 1px dotted #bbb;
1354             }
1355             :link:hover, :visited:hover {
1356                     color: #555;
1357             }
1358             div#topbar {
1359                 margin: 0px;
1360             }
1361             pre {
1362                 margin: 10px;
1363                 padding: 8px;
1364             }
1365             div#answers {
1366                 padding: 8px;
1367                 margin: 10px;
1368                 background-color: #fff;
1369                 border: 1px solid #aaa;
1370             }
1371             h1 {
1372                 font-size: 0.9em;
1373                 font-weight: normal;
1374                 text-align: center;
1375             }
1376             h2 {
1377                 font-size: 1.0em;
1378             }
1379             p {
1380                 font-size: 0.9em;
1381             }
1382             p img {
1383                 float: right;
1384                 margin-left: 10px;
1385             }
1386             span#appname {
1387                 font-weight: bold;
1388                 font-size: 1.6em;
1389             }
1390         </style>
1391     </head>
1392     <body>
1393         <div id="content">
1394             <div id="topbar">
1395                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1396                     $VERSION</h1>
1397              </div>
1398              <div id="answers">
1399                  <p>
1400                  <img src="$logo" alt="Catalyst Logo" />
1401                  </p>
1402                  <p>Welcome to the  world of Catalyst.
1403                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1404                     framework will make web development something you had
1405                     never expected it to be: Fun, rewarding, and quick.</p>
1406                  <h2>What to do now?</h2>
1407                  <p>That really depends  on what <b>you</b> want to do.
1408                     We do, however, provide you with a few starting points.</p>
1409                  <p>If you want to jump right into web development with Catalyst
1410                     you might want to start with a tutorial.</p>
1411 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1412 </pre>
1413 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1414 <pre>
1415 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1416 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1417 </code></pre>
1418                  <h2>What to do next?</h2>
1419                  <p>Next it's time to write an actual application. Use the
1420                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1421                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1422                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1423                     they can save you a lot of work.</p>
1424                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1425                     <p>Also, be sure to check out the vast and growing
1426                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1427                     you are likely to find what you need there.
1428                     </p>
1429
1430                  <h2>Need help?</h2>
1431                  <p>Catalyst has a very active community. Here are the main places to
1432                     get in touch with us.</p>
1433                  <ul>
1434                      <li>
1435                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1436                      </li>
1437                      <li>
1438                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1439                      </li>
1440                      <li>
1441                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1442                      </li>
1443                  </ul>
1444                  <h2>In conclusion</h2>
1445                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1446                     as we enjoyed making it. Please contact us if you have ideas
1447                     for improvement or other feedback.</p>
1448              </div>
1449          </div>
1450     </body>
1451 </html>
1452 EOF
1453 }
1454
1455 =head1 INTERNAL METHODS
1456
1457 These methods are not meant to be used by end users.
1458
1459 =head2 $c->components
1460
1461 Returns a hash of components.
1462
1463 =cut
1464
1465 # FIXME - We deal with ->components({'Foo' => 'Bar'})
1466 #         however we DO NOT deal with ->components->{Foo} = 'Bar'
1467 #         We should return a locked hash back to the user? So that if they try the latter, they
1468 #         get breakage, rather than their addition being silently ignored?
1469 around components => sub {
1470     my $orig  = shift;
1471     my $class = shift;
1472     my $comps = shift;
1473
1474     return $class->$orig if ( !$comps );
1475
1476 # FIXME: should this ugly kludge exist?
1477     $class->setup_config unless defined $class->container;
1478
1479 # FIXME: should there be a warning here, not to use this accessor to create the components?
1480     my $components = {};
1481
1482     my $containers;
1483     $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
1484
1485     for my $component ( keys %$comps ) {
1486         $components->{ $component } = $comps->{$component};
1487
1488         my ($type, $name) = _get_component_type_name($component);
1489
1490         $containers->{$type}->add_service(Catalyst::IOC::BlockInjection->new( name => $name, block => sub { return $class->setup_component($component) } ));
1491     }
1492
1493     return $class->$orig($components);
1494 };
1495
1496 =head2 $c->context_class
1497
1498 Returns or sets the context class.
1499
1500 =head2 $c->counter
1501
1502 Returns a hashref containing coderefs and execution counts (needed for
1503 deep recursion detection).
1504
1505 =head2 $c->depth
1506
1507 Returns the number of actions on the current internal execution stack.
1508
1509 =head2 $c->dispatch
1510
1511 Dispatches a request to actions.
1512
1513 =cut
1514
1515 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1516
1517 =head2 $c->dispatcher_class
1518
1519 Returns or sets the dispatcher class.
1520
1521 =head2 $c->dump_these
1522
1523 Returns a list of 2-element array references (name, structure) pairs
1524 that will be dumped on the error page in debug mode.
1525
1526 =cut
1527
1528 sub dump_these {
1529     my $c = shift;
1530     [ Request => $c->req ],
1531     [ Response => $c->res ],
1532     [ Stash => $c->stash ],
1533     [ Config => $c->config ];
1534 }
1535
1536 =head2 $c->engine_class
1537
1538 Returns or sets the engine class.
1539
1540 =head2 $c->execute( $class, $coderef )
1541
1542 Execute a coderef in given class and catch exceptions. Errors are available
1543 via $c->error.
1544
1545 =cut
1546
1547 sub execute {
1548     my ( $c, $class, $code ) = @_;
1549     $class = $c->component($class) || $class;
1550     $c->state(0);
1551
1552     if ( $c->depth >= $RECURSION ) {
1553         my $action = $code->reverse();
1554         $action = "/$action" unless $action =~ /->/;
1555         my $error = qq/Deep recursion detected calling "${action}"/;
1556         $c->log->error($error);
1557         $c->error($error);
1558         $c->state(0);
1559         return $c->state;
1560     }
1561
1562     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1563
1564     push( @{ $c->stack }, $code );
1565
1566     no warnings 'recursion';
1567     # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1568     #      I have no idea how, ergo $ret (which appears to fix the issue)
1569     eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
1570
1571     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1572
1573     my $last = pop( @{ $c->stack } );
1574
1575     if ( my $error = $@ ) {
1576         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1577             $error->rethrow if $c->depth > 1;
1578         }
1579         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1580             $error->rethrow if $c->depth > 0;
1581         }
1582         else {
1583             unless ( ref $error ) {
1584                 no warnings 'uninitialized';
1585                 chomp $error;
1586                 my $class = $last->class;
1587                 my $name  = $last->name;
1588                 $error = qq/Caught exception in $class->$name "$error"/;
1589             }
1590             $c->error($error);
1591         }
1592         $c->state(0);
1593     }
1594     return $c->state;
1595 }
1596
1597 sub _stats_start_execute {
1598     my ( $c, $code ) = @_;
1599     my $appclass = ref($c) || $c;
1600     return if ( ( $code->name =~ /^_.*/ )
1601         && ( !$appclass->config->{show_internal_actions} ) );
1602
1603     my $action_name = $code->reverse();
1604     $c->counter->{$action_name}++;
1605
1606     my $action = $action_name;
1607     $action = "/$action" unless $action =~ /->/;
1608
1609     # determine if the call was the result of a forward
1610     # this is done by walking up the call stack and looking for a calling
1611     # sub of Catalyst::forward before the eval
1612     my $callsub = q{};
1613     for my $index ( 2 .. 11 ) {
1614         last
1615         if ( ( caller($index) )[0] eq 'Catalyst'
1616             && ( caller($index) )[3] eq '(eval)' );
1617
1618         if ( ( caller($index) )[3] =~ /forward$/ ) {
1619             $callsub = ( caller($index) )[3];
1620             $action  = "-> $action";
1621             last;
1622         }
1623     }
1624
1625     my $uid = $action_name . $c->counter->{$action_name};
1626
1627     # is this a root-level call or a forwarded call?
1628     if ( $callsub =~ /forward$/ ) {
1629         my $parent = $c->stack->[-1];
1630
1631         # forward, locate the caller
1632         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1633             $c->stats->profile(
1634                 begin  => $action,
1635                 parent => "$parent" . $c->counter->{"$parent"},
1636                 uid    => $uid,
1637             );
1638         }
1639         else {
1640
1641             # forward with no caller may come from a plugin
1642             $c->stats->profile(
1643                 begin => $action,
1644                 uid   => $uid,
1645             );
1646         }
1647     }
1648     else {
1649
1650         # root-level call
1651         $c->stats->profile(
1652             begin => $action,
1653             uid   => $uid,
1654         );
1655     }
1656     return $action;
1657
1658 }
1659
1660 sub _stats_finish_execute {
1661     my ( $c, $info ) = @_;
1662     $c->stats->profile( end => $info );
1663 }
1664
1665 =head2 $c->finalize
1666
1667 Finalizes the request.
1668
1669 =cut
1670
1671 sub finalize {
1672     my $c = shift;
1673
1674     for my $error ( @{ $c->error } ) {
1675         $c->log->error($error);
1676     }
1677
1678     # Allow engine to handle finalize flow (for POE)
1679     my $engine = $c->engine;
1680     if ( my $code = $engine->can('finalize') ) {
1681         $engine->$code($c);
1682     }
1683     else {
1684
1685         $c->finalize_uploads;
1686
1687         # Error
1688         if ( $#{ $c->error } >= 0 ) {
1689             $c->finalize_error;
1690         }
1691
1692         $c->finalize_headers;
1693
1694         # HEAD request
1695         if ( $c->request->method eq 'HEAD' ) {
1696             $c->response->body('');
1697         }
1698
1699         $c->finalize_body;
1700     }
1701
1702     $c->log_response;
1703
1704     if ($c->use_stats) {
1705         my $elapsed = sprintf '%f', $c->stats->elapsed;
1706         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1707         $c->log->info(
1708             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1709     }
1710
1711     return $c->response->status;
1712 }
1713
1714 =head2 $c->finalize_body
1715
1716 Finalizes body.
1717
1718 =cut
1719
1720 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1721
1722 =head2 $c->finalize_cookies
1723
1724 Finalizes cookies.
1725
1726 =cut
1727
1728 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1729
1730 =head2 $c->finalize_error
1731
1732 Finalizes error.
1733
1734 =cut
1735
1736 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1737
1738 =head2 $c->finalize_headers
1739
1740 Finalizes headers.
1741
1742 =cut
1743
1744 sub finalize_headers {
1745     my $c = shift;
1746
1747     my $response = $c->response; #accessor calls can add up?
1748
1749     # Check if we already finalized headers
1750     return if $response->finalized_headers;
1751
1752     # Handle redirects
1753     if ( my $location = $response->redirect ) {
1754         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1755         $response->header( Location => $location );
1756
1757         if ( !$response->has_body ) {
1758             # Add a default body if none is already present
1759             $response->body(
1760                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1761             );
1762         }
1763     }
1764
1765     # Content-Length
1766     if ( defined $response->body && length $response->body && !$response->content_length ) {
1767
1768         # get the length from a filehandle
1769         if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
1770         {
1771             my $stat = stat $response->body;
1772             if ( $stat && $stat->size > 0 ) {
1773                 $response->content_length( $stat->size );
1774             }
1775             else {
1776                 $c->log->warn('Serving filehandle without a content-length');
1777             }
1778         }
1779         else {
1780             # everything should be bytes at this point, but just in case
1781             $response->content_length( length( $response->body ) );
1782         }
1783     }
1784
1785     # Errors
1786     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1787         $response->headers->remove_header("Content-Length");
1788         $response->body('');
1789     }
1790
1791     $c->finalize_cookies;
1792
1793     $c->engine->finalize_headers( $c, @_ );
1794
1795     # Done
1796     $response->finalized_headers(1);
1797 }
1798
1799 =head2 $c->finalize_output
1800
1801 An alias for finalize_body.
1802
1803 =head2 $c->finalize_read
1804
1805 Finalizes the input after reading is complete.
1806
1807 =cut
1808
1809 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1810
1811 =head2 $c->finalize_uploads
1812
1813 Finalizes uploads. Cleans up any temporary files.
1814
1815 =cut
1816
1817 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1818
1819 =head2 $c->get_action( $action, $namespace )
1820
1821 Gets an action in a given namespace.
1822
1823 =cut
1824
1825 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1826
1827 =head2 $c->get_actions( $action, $namespace )
1828
1829 Gets all actions of a given name in a namespace and all parent
1830 namespaces.
1831
1832 =cut
1833
1834 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1835
1836 =head2 $app->handle_request( @arguments )
1837
1838 Called to handle each HTTP request.
1839
1840 =cut
1841
1842 sub handle_request {
1843     my ( $class, @arguments ) = @_;
1844
1845     # Always expect worst case!
1846     my $status = -1;
1847     eval {
1848         if ($class->debug) {
1849             my $secs = time - $START || 1;
1850             my $av = sprintf '%.3f', $COUNT / $secs;
1851             my $time = localtime time;
1852             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1853         }
1854
1855         my $c = $class->prepare(@arguments);
1856         $c->dispatch;
1857         $status = $c->finalize;
1858     };
1859
1860     if ( my $error = $@ ) {
1861         chomp $error;
1862         $class->log->error(qq/Caught exception in engine "$error"/);
1863     }
1864
1865     $COUNT++;
1866
1867     if(my $coderef = $class->log->can('_flush')){
1868         $class->log->$coderef();
1869     }
1870     return $status;
1871 }
1872
1873 =head2 $c->prepare( @arguments )
1874
1875 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1876 etc.).
1877
1878 =cut
1879
1880 sub prepare {
1881     my ( $class, @arguments ) = @_;
1882
1883     # XXX
1884     # After the app/ctxt split, this should become an attribute based on something passed
1885     # into the application.
1886     $class->context_class( ref $class || $class ) unless $class->context_class;
1887
1888     my $c = $class->context_class->new({});
1889
1890     # For on-demand data
1891     $c->request->_context($c);
1892     $c->response->_context($c);
1893
1894     #surely this is not the most efficient way to do things...
1895     $c->stats($class->stats_class->new)->enable($c->use_stats);
1896     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
1897         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1898     }
1899
1900     #XXX reuse coderef from can
1901     # Allow engine to direct the prepare flow (for POE)
1902     if ( $c->engine->can('prepare') ) {
1903         $c->engine->prepare( $c, @arguments );
1904     }
1905     else {
1906         $c->prepare_request(@arguments);
1907         $c->prepare_connection;
1908         $c->prepare_query_parameters;
1909         $c->prepare_headers;
1910         $c->prepare_cookies;
1911         $c->prepare_path;
1912
1913         # Prepare the body for reading, either by prepare_body
1914         # or the user, if they are using $c->read
1915         $c->prepare_read;
1916
1917         # Parse the body unless the user wants it on-demand
1918         unless ( ref($c)->config->{parse_on_demand} ) {
1919             $c->prepare_body;
1920         }
1921     }
1922
1923     my $method  = $c->req->method  || '';
1924     my $path    = $c->req->path;
1925     $path       = '/' unless length $path;
1926     my $address = $c->req->address || '';
1927
1928     $c->log_request;
1929
1930     $c->prepare_action;
1931
1932     return $c;
1933 }
1934
1935 =head2 $c->prepare_action
1936
1937 Prepares action. See L<Catalyst::Dispatcher>.
1938
1939 =cut
1940
1941 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1942
1943 =head2 $c->prepare_body
1944
1945 Prepares message body.
1946
1947 =cut
1948
1949 sub prepare_body {
1950     my $c = shift;
1951
1952     return if $c->request->_has_body;
1953
1954     # Initialize on-demand data
1955     $c->engine->prepare_body( $c, @_ );
1956     $c->prepare_parameters;
1957     $c->prepare_uploads;
1958 }
1959
1960 =head2 $c->prepare_body_chunk( $chunk )
1961
1962 Prepares a chunk of data before sending it to L<HTTP::Body>.
1963
1964 See L<Catalyst::Engine>.
1965
1966 =cut
1967
1968 sub prepare_body_chunk {
1969     my $c = shift;
1970     $c->engine->prepare_body_chunk( $c, @_ );
1971 }
1972
1973 =head2 $c->prepare_body_parameters
1974
1975 Prepares body parameters.
1976
1977 =cut
1978
1979 sub prepare_body_parameters {
1980     my $c = shift;
1981     $c->engine->prepare_body_parameters( $c, @_ );
1982 }
1983
1984 =head2 $c->prepare_connection
1985
1986 Prepares connection.
1987
1988 =cut
1989
1990 sub prepare_connection {
1991     my $c = shift;
1992     $c->engine->prepare_connection( $c, @_ );
1993 }
1994
1995 =head2 $c->prepare_cookies
1996
1997 Prepares cookies.
1998
1999 =cut
2000
2001 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
2002
2003 =head2 $c->prepare_headers
2004
2005 Prepares headers.
2006
2007 =cut
2008
2009 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
2010
2011 =head2 $c->prepare_parameters
2012
2013 Prepares parameters.
2014
2015 =cut
2016
2017 sub prepare_parameters {
2018     my $c = shift;
2019     $c->prepare_body_parameters;
2020     $c->engine->prepare_parameters( $c, @_ );
2021 }
2022
2023 =head2 $c->prepare_path
2024
2025 Prepares path and base.
2026
2027 =cut
2028
2029 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2030
2031 =head2 $c->prepare_query_parameters
2032
2033 Prepares query parameters.
2034
2035 =cut
2036
2037 sub prepare_query_parameters {
2038     my $c = shift;
2039
2040     $c->engine->prepare_query_parameters( $c, @_ );
2041 }
2042
2043 =head2 $c->log_request
2044
2045 Writes information about the request to the debug logs.  This includes:
2046
2047 =over 4
2048
2049 =item * Request method, path, and remote IP address
2050
2051 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2052
2053 =item * Request parameters
2054
2055 =item * File uploads
2056
2057 =back
2058
2059 =cut
2060
2061 sub log_request {
2062     my $c = shift;
2063
2064     return unless $c->debug;
2065
2066     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2067     my $request = $dump->[1];
2068
2069     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2070     $method ||= '';
2071     $path = '/' unless length $path;
2072     $address ||= '';
2073     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2074
2075     $c->log_request_headers($request->headers);
2076
2077     if ( my $keywords = $request->query_keywords ) {
2078         $c->log->debug("Query keywords are: $keywords");
2079     }
2080
2081     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2082
2083     $c->log_request_uploads($request);
2084 }
2085
2086 =head2 $c->log_response
2087
2088 Writes information about the response to the debug logs by calling
2089 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2090
2091 =cut
2092
2093 sub log_response {
2094     my $c = shift;
2095
2096     return unless $c->debug;
2097
2098     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2099     my $response = $dump->[1];
2100
2101     $c->log_response_status_line($response);
2102     $c->log_response_headers($response->headers);
2103 }
2104
2105 =head2 $c->log_response_status_line($response)
2106
2107 Writes one line of information about the response to the debug logs.  This includes:
2108
2109 =over 4
2110
2111 =item * Response status code
2112
2113 =item * Content-Type header (if present)
2114
2115 =item * Content-Length header (if present)
2116
2117 =back
2118
2119 =cut
2120
2121 sub log_response_status_line {
2122     my ($c, $response) = @_;
2123
2124     $c->log->debug(
2125         sprintf(
2126             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2127             $response->status                            || 'unknown',
2128             $response->headers->header('Content-Type')   || 'unknown',
2129             $response->headers->header('Content-Length') || 'unknown'
2130         )
2131     );
2132 }
2133
2134 =head2 $c->log_response_headers($headers);
2135
2136 Hook method which can be wrapped by plugins to log the responseheaders.
2137 No-op in the default implementation.
2138
2139 =cut
2140
2141 sub log_response_headers {}
2142
2143 =head2 $c->log_request_parameters( query => {}, body => {} )
2144
2145 Logs request parameters to debug logs
2146
2147 =cut
2148
2149 sub log_request_parameters {
2150     my $c          = shift;
2151     my %all_params = @_;
2152
2153     return unless $c->debug;
2154
2155     my $column_width = Catalyst::Utils::term_width() - 44;
2156     foreach my $type (qw(query body)) {
2157         my $params = $all_params{$type};
2158         next if ! keys %$params;
2159         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2160         for my $key ( sort keys %$params ) {
2161             my $param = $params->{$key};
2162             my $value = defined($param) ? $param : '';
2163             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2164         }
2165         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2166     }
2167 }
2168
2169 =head2 $c->log_request_uploads
2170
2171 Logs file uploads included in the request to the debug logs.
2172 The parameter name, filename, file type, and file size are all included in
2173 the debug logs.
2174
2175 =cut
2176
2177 sub log_request_uploads {
2178     my $c = shift;
2179     my $request = shift;
2180     return unless $c->debug;
2181     my $uploads = $request->uploads;
2182     if ( keys %$uploads ) {
2183         my $t = Text::SimpleTable->new(
2184             [ 12, 'Parameter' ],
2185             [ 26, 'Filename' ],
2186             [ 18, 'Type' ],
2187             [ 9,  'Size' ]
2188         );
2189         for my $key ( sort keys %$uploads ) {
2190             my $upload = $uploads->{$key};
2191             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2192                 $t->row( $key, $u->filename, $u->type, $u->size );
2193             }
2194         }
2195         $c->log->debug( "File Uploads are:\n" . $t->draw );
2196     }
2197 }
2198
2199 =head2 $c->log_request_headers($headers);
2200
2201 Hook method which can be wrapped by plugins to log the request headers.
2202 No-op in the default implementation.
2203
2204 =cut
2205
2206 sub log_request_headers {}
2207
2208 =head2 $c->log_headers($type => $headers)
2209
2210 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2211
2212 =cut
2213
2214 sub log_headers {
2215     my $c       = shift;
2216     my $type    = shift;
2217     my $headers = shift;    # an HTTP::Headers instance
2218
2219     return unless $c->debug;
2220
2221     my $column_width = Catalyst::Utils::term_width() - 28;
2222     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2223     $headers->scan(
2224         sub {
2225             my ( $name, $value ) = @_;
2226             $t->row( $name, $value );
2227         }
2228     );
2229     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2230 }
2231
2232
2233 =head2 $c->prepare_read
2234
2235 Prepares the input for reading.
2236
2237 =cut
2238
2239 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2240
2241 =head2 $c->prepare_request
2242
2243 Prepares the engine request.
2244
2245 =cut
2246
2247 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2248
2249 =head2 $c->prepare_uploads
2250
2251 Prepares uploads.
2252
2253 =cut
2254
2255 sub prepare_uploads {
2256     my $c = shift;
2257
2258     $c->engine->prepare_uploads( $c, @_ );
2259 }
2260
2261 =head2 $c->prepare_write
2262
2263 Prepares the output for writing.
2264
2265 =cut
2266
2267 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2268
2269 =head2 $c->request_class
2270
2271 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2272
2273 =head2 $c->response_class
2274
2275 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2276
2277 =head2 $c->read( [$maxlength] )
2278
2279 Reads a chunk of data from the request body. This method is designed to
2280 be used in a while loop, reading C<$maxlength> bytes on every call.
2281 C<$maxlength> defaults to the size of the request if not specified.
2282
2283 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2284 directly.
2285
2286 Warning: If you use read(), Catalyst will not process the body,
2287 so you will not be able to access POST parameters or file uploads via
2288 $c->request.  You must handle all body parsing yourself.
2289
2290 =cut
2291
2292 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2293
2294 =head2 $c->run
2295
2296 Starts the engine.
2297
2298 =cut
2299
2300 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2301
2302 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2303
2304 Sets an action in a given namespace.
2305
2306 =cut
2307
2308 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2309
2310 =head2 $c->setup_actions($component)
2311
2312 Sets up actions for a component.
2313
2314 =cut
2315
2316 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2317
2318 =head2 $c->setup_config
2319
2320 =cut
2321
2322 sub setup_config {
2323     my $class = shift;
2324
2325     my %args = %{ $class->config || {} };
2326
2327     my @container_classes = ( "${class}::Container", 'Catalyst::IOC::Container');
2328     unshift @container_classes, delete $args{container_class} if exists $args{container_class};
2329
2330     my $container_class = Class::MOP::load_first_existing_class(@container_classes);
2331
2332     my $container = $container_class->new( %args, name => "$class" );
2333     $class->container($container);
2334
2335     my $config = $container->resolve(service => 'config');
2336     $class->config($config);
2337     $class->finalize_config; # back-compat
2338 }
2339
2340 =head2 $c->finalize_config
2341
2342 =cut
2343
2344 sub finalize_config { }
2345
2346 =head2 $c->setup_components
2347
2348 This method is called internally to set up the application's components.
2349
2350 It finds modules by calling the L<locate_components> method, expands them to
2351 package names with the L<expand_component_module> method, and then installs
2352 each component into the application.
2353
2354 The C<setup_components> config option is passed to both of the above methods.
2355
2356 Installation of each component is performed by the L<setup_component> method,
2357 below.
2358
2359 =cut
2360
2361 sub setup_components {
2362     my $class = shift;
2363
2364     my $config  = $class->config->{ setup_components };
2365     my $search_extra = $config->{ search_extra };
2366
2367     my @comps = $class->locate_components($config);
2368     my %comps = map { $_ => 1 } @comps;
2369
2370     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2371     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2372         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2373     ) if $deprecatedcatalyst_component_names;
2374
2375     for my $component ( @comps ) {
2376
2377         # We pass ignore_loaded here so that overlay files for (e.g.)
2378         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2379         # we know M::P::O found a file on disk so this is safe
2380
2381         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2382     }
2383
2384     my $containers;
2385     $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
2386
2387     for my $component (@comps) {
2388         my $instance = $class->components->{ $component } = $class->setup_component($component);
2389         if ( my ($type, $name) = _get_component_type_name($component, $search_extra) ) {
2390             $containers->{$type}->add_service(Catalyst::IOC::BlockInjection->new( name => $name, block => sub { return $instance } ));
2391         }
2392         my @expanded_components = $instance->can('expand_modules')
2393             ? $instance->expand_modules( $component, $config )
2394             : $class->expand_component_module( $component, $config );
2395         for my $component (@expanded_components) {
2396             next if $comps{$component};
2397
2398             $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components;
2399             $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2400                 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2401             ) if $deprecatedcatalyst_component_names;
2402
2403             if (my ($type, $name) = _get_component_type_name($component, $search_extra)) {
2404                 $containers->{$type}->add_service(Catalyst::IOC::BlockInjection->new( name => $name, block => sub { return $class->setup_component($component) } ));
2405             }
2406
2407             # FIXME - Remove this!!
2408             $class->components->{ $component } = $class->setup_component($component);
2409         }
2410     }
2411
2412     $containers->{model}->make_single_default;
2413     $containers->{view}->make_single_default;
2414 }
2415
2416 # FIXME: should this sub exist?
2417 # should it be moved to Catalyst::Utils,
2418 # or replaced by something already existing there?
2419 sub _get_component_type_name {
2420     my ( $component, $search_extra) = @_;
2421     $search_extra ||= [];
2422     my @search_extra = map { s/^:://; lc $_ } @$search_extra;
2423
2424     my @parts = split /::/, $component;
2425
2426     if (scalar @parts == 1) {
2427         return (undef, $component);
2428     }
2429
2430     while (my $type = shift @parts) {
2431         return ('controller', join '::', @parts)
2432             if $type =~ /^(c|controller)$/i;
2433
2434         return ('model', join '::', @parts)
2435             if $type =~ /^(m|model)$/i;
2436
2437         return ('view', join '::', @parts)
2438             if $type =~ /^(v|view)$/i;
2439
2440         return (_get_component_type($component), join '::', @parts)
2441             if @search_extra and ( grep { lc $type eq $_ } @search_extra );
2442     }
2443 }
2444
2445 sub _get_component_type {
2446     my ( $instance ) = @_;
2447
2448     return 'controller' if $instance->isa('Catalyst::Controller');
2449     return 'model'      if $instance->isa('Catalyst::Model');
2450     return 'view'       if $instance->isa('Catalyst::View');
2451 }
2452
2453 =head2 $c->locate_components( $setup_component_config )
2454
2455 This method is meant to provide a list of component modules that should be
2456 setup for the application.  By default, it will use L<Module::Pluggable>.
2457
2458 Specify a C<setup_components> config option to pass additional options directly
2459 to L<Module::Pluggable>. To add additional search paths, specify a key named
2460 C<search_extra> as an array reference. Items in the array beginning with C<::>
2461 will have the application class name prepended to them.
2462
2463 =cut
2464
2465 sub locate_components {
2466     my $class  = shift;
2467     my $config = shift;
2468
2469     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2470     my $extra   = delete $config->{ search_extra } || [];
2471
2472     push @paths, @$extra;
2473
2474     my $locator = Module::Pluggable::Object->new(
2475         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2476         %$config
2477     );
2478
2479     # XXX think about ditching this sort entirely
2480     my @comps = sort { length $a <=> length $b } $locator->plugins;
2481
2482     return @comps;
2483 }
2484
2485 =head2 $c->expand_component_module( $component, $setup_component_config )
2486
2487 Components found by C<locate_components> will be passed to this method, which
2488 is expected to return a list of component (package) names to be set up.
2489
2490 =cut
2491
2492 sub expand_component_module {
2493     my ($class, $module) = @_;
2494     return Devel::InnerPackage::list_packages( $module );
2495 }
2496
2497 =head2 $c->setup_component
2498
2499 =cut
2500
2501 ## FIXME - Why the hell do we try calling the ->COMPONENT method twice, this is madness!?!
2502 sub setup_component {
2503     my( $class, $component ) = @_;
2504
2505     unless ( $component->can( 'COMPONENT' ) ) {
2506         return $component;
2507     }
2508
2509     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2510     my $config = $class->config->{ $suffix } || {};
2511     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2512     # methods also pass it. local to avoid pointlessly shitting in config
2513     # for the debug screen, as $component is already the key name.
2514     local $config->{catalyst_component_name} = $component;
2515
2516     my $instance = eval { $component->COMPONENT( $class, $config ); };
2517
2518     if ( my $error = $@ ) {
2519         chomp $error;
2520         Catalyst::Exception->throw(
2521             message => qq/Couldn't instantiate component "$component", "$error"/
2522         );
2523     }
2524     elsif (!blessed $instance) {
2525         my $metaclass = Moose::Util::find_meta($component);
2526         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2527         my $component_method_from = $method_meta->associated_metaclass->name;
2528         my $value = defined($instance) ? $instance : 'undef';
2529         Catalyst::Exception->throw(
2530             message =>
2531             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2532         );
2533     }
2534
2535     return $instance;
2536 }
2537
2538 =head2 $c->setup_dispatcher
2539
2540 Sets up dispatcher.
2541
2542 =cut
2543
2544 sub setup_dispatcher {
2545     my ( $class, $dispatcher ) = @_;
2546
2547     if ($dispatcher) {
2548         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2549     }
2550
2551     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2552         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2553     }
2554
2555     unless ($dispatcher) {
2556         $dispatcher = $class->dispatcher_class;
2557     }
2558
2559     Class::MOP::load_class($dispatcher);
2560
2561     # dispatcher instance
2562     $class->dispatcher( $dispatcher->new );
2563 }
2564
2565 =head2 $c->setup_engine
2566
2567 Sets up engine.
2568
2569 =cut
2570
2571 sub setup_engine {
2572     my ( $class, $engine ) = @_;
2573
2574     if ($engine) {
2575         $engine = 'Catalyst::Engine::' . $engine;
2576     }
2577
2578     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2579         $engine = 'Catalyst::Engine::' . $env;
2580     }
2581
2582     if ( $ENV{MOD_PERL} ) {
2583         my $meta = Class::MOP::get_metaclass_by_name($class);
2584
2585         # create the apache method
2586         $meta->add_method('apache' => sub { shift->engine->apache });
2587
2588         my ( $software, $version ) =
2589           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2590
2591         $version =~ s/_//g;
2592         $version =~ s/(\.[^.]+)\./$1/g;
2593
2594         if ( $software eq 'mod_perl' ) {
2595
2596             if ( !$engine ) {
2597
2598                 if ( $version >= 1.99922 ) {
2599                     $engine = 'Catalyst::Engine::Apache2::MP20';
2600                 }
2601
2602                 elsif ( $version >= 1.9901 ) {
2603                     $engine = 'Catalyst::Engine::Apache2::MP19';
2604                 }
2605
2606                 elsif ( $version >= 1.24 ) {
2607                     $engine = 'Catalyst::Engine::Apache::MP13';
2608                 }
2609
2610                 else {
2611                     Catalyst::Exception->throw( message =>
2612                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2613                 }
2614
2615             }
2616
2617             # install the correct mod_perl handler
2618             if ( $version >= 1.9901 ) {
2619                 *handler = sub  : method {
2620                     shift->handle_request(@_);
2621                 };
2622             }
2623             else {
2624                 *handler = sub ($$) { shift->handle_request(@_) };
2625             }
2626
2627         }
2628
2629         elsif ( $software eq 'Zeus-Perl' ) {
2630             $engine = 'Catalyst::Engine::Zeus';
2631         }
2632
2633         else {
2634             Catalyst::Exception->throw(
2635                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2636         }
2637     }
2638
2639     unless ($engine) {
2640         $engine = $class->engine_class;
2641     }
2642
2643     Class::MOP::load_class($engine);
2644
2645     # check for old engines that are no longer compatible
2646     my $old_engine;
2647     if ( $engine->isa('Catalyst::Engine::Apache')
2648         && !Catalyst::Engine::Apache->VERSION )
2649     {
2650         $old_engine = 1;
2651     }
2652
2653     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2654         && Catalyst::Engine::Server->VERSION le '0.02' )
2655     {
2656         $old_engine = 1;
2657     }
2658
2659     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2660         && $engine->VERSION eq '0.01' )
2661     {
2662         $old_engine = 1;
2663     }
2664
2665     elsif ($engine->isa('Catalyst::Engine::Zeus')
2666         && $engine->VERSION eq '0.01' )
2667     {
2668         $old_engine = 1;
2669     }
2670
2671     if ($old_engine) {
2672         Catalyst::Exception->throw( message =>
2673               qq/Engine "$engine" is not supported by this version of Catalyst/
2674         );
2675     }
2676
2677     # engine instance
2678     $class->engine( $engine->new );
2679 }
2680
2681 =head2 $c->setup_home
2682
2683 Sets up the home directory.
2684
2685 =cut
2686
2687 sub setup_home {
2688     my ( $class, $home ) = @_;
2689
2690     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2691         $home = $env;
2692     }
2693
2694     $home ||= Catalyst::Utils::home($class);
2695
2696     if ($home) {
2697         #I remember recently being scolded for assigning config values like this
2698         $class->config->{home} ||= $home;
2699         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2700     }
2701 }
2702
2703 =head2 $c->setup_log
2704
2705 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2706 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2707 log to.
2708
2709 This method also installs a C<debug> method that returns a true value into the
2710 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2711 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2712
2713 Note that if the log has already been setup, by either a previous call to
2714 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2715 that this method won't actually set up the log object.
2716
2717 =cut
2718
2719 sub setup_log {
2720     my ( $class, $levels ) = @_;
2721
2722     $levels ||= '';
2723     $levels =~ s/^\s+//;
2724     $levels =~ s/\s+$//;
2725     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2726
2727     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2728     if ( defined $env_debug ) {
2729         $levels{debug} = 1 if $env_debug; # Ugly!
2730         delete($levels{debug}) unless $env_debug;
2731     }
2732
2733     unless ( $class->log ) {
2734         $class->log( Catalyst::Log->new(keys %levels) );
2735     }
2736
2737     if ( $levels{debug} ) {
2738         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2739         $class->log->debug('Debug messages enabled');
2740     }
2741 }
2742
2743 =head2 $c->setup_plugins
2744
2745 Sets up plugins.
2746
2747 =cut
2748
2749 =head2 $c->setup_stats
2750
2751 Sets up timing statistics class.
2752
2753 =cut
2754
2755 sub setup_stats {
2756     my ( $class, $stats ) = @_;
2757
2758     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2759
2760     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2761     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2762         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2763         $class->log->debug('Statistics enabled');
2764     }
2765 }
2766
2767
2768 =head2 $c->registered_plugins
2769
2770 Returns a sorted list of the plugins which have either been stated in the
2771 import list or which have been added via C<< MyApp->plugin(@args); >>.
2772
2773 If passed a given plugin name, it will report a boolean value indicating
2774 whether or not that plugin is loaded.  A fully qualified name is required if
2775 the plugin name does not begin with C<Catalyst::Plugin::>.
2776
2777  if ($c->registered_plugins('Some::Plugin')) {
2778      ...
2779  }
2780
2781 =cut
2782
2783 {
2784
2785     sub registered_plugins {
2786         my $proto = shift;
2787         return sort keys %{ $proto->_plugins } unless @_;
2788         my $plugin = shift;
2789         return 1 if exists $proto->_plugins->{$plugin};
2790         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2791     }
2792
2793     sub _register_plugin {
2794         my ( $proto, $plugin, $instant ) = @_;
2795         my $class = ref $proto || $proto;
2796
2797         Class::MOP::load_class( $plugin );
2798         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
2799             if $plugin->isa( 'Catalyst::Component' );
2800         $proto->_plugins->{$plugin} = 1;
2801         unless ($instant) {
2802             my $meta = Class::MOP::get_metaclass_by_name($class);
2803             $meta->superclasses($plugin, $meta->superclasses);
2804         }
2805         return $class;
2806     }
2807
2808     sub setup_plugins {
2809         my ( $class, $plugins ) = @_;
2810
2811         $class->_plugins( {} ) unless $class->_plugins;
2812         $plugins = Data::OptList::mkopt($plugins || []);
2813
2814         my @plugins = map {
2815             [ Catalyst::Utils::resolve_namespace(
2816                   $class . '::Plugin',
2817                   'Catalyst::Plugin', $_->[0]
2818               ),
2819               $_->[1],
2820             ]
2821          } @{ $plugins };
2822
2823         for my $plugin ( reverse @plugins ) {
2824             Class::MOP::load_class($plugin->[0], $plugin->[1]);
2825             my $meta = find_meta($plugin->[0]);
2826             next if $meta && $meta->isa('Moose::Meta::Role');
2827
2828             $class->_register_plugin($plugin->[0]);
2829         }
2830
2831         my @roles =
2832             map  { $_->[0]->name, $_->[1] }
2833             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
2834             map  { [find_meta($_->[0]), $_->[1]] }
2835             @plugins;
2836
2837         Moose::Util::apply_all_roles(
2838             $class => @roles
2839         ) if @roles;
2840     }
2841 }
2842
2843 =head2 $c->stack
2844
2845 Returns an arrayref of the internal execution stack (actions that are
2846 currently executing).
2847
2848 =head2 $c->stats
2849
2850 Returns the current timing statistics object. By default Catalyst uses
2851 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
2852 L<< stats_class|/"$c->stats_class" >>.
2853
2854 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
2855 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
2856 profile explicitly, although MyApp.pm still won't profile nor output anything
2857 by itself.
2858
2859 =head2 $c->stats_class
2860
2861 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
2862
2863 =head2 $c->use_stats
2864
2865 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
2866
2867 Note that this is a static method, not an accessor and should be overridden
2868 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2869
2870 =cut
2871
2872 sub use_stats { 0 }
2873
2874
2875 =head2 $c->write( $data )
2876
2877 Writes $data to the output stream. When using this method directly, you
2878 will need to manually set the C<Content-Length> header to the length of
2879 your output data, if known.
2880
2881 =cut
2882
2883 sub write {
2884     my $c = shift;
2885
2886     # Finalize headers if someone manually writes output
2887     $c->finalize_headers;
2888
2889     return $c->engine->write( $c, @_ );
2890 }
2891
2892 =head2 version
2893
2894 Returns the Catalyst version number. Mostly useful for "powered by"
2895 messages in template systems.
2896
2897 =cut
2898
2899 sub version { return $Catalyst::VERSION }
2900
2901 =head1 CONFIGURATION
2902
2903 There are a number of 'base' config variables which can be set:
2904
2905 =over
2906
2907 =item *
2908
2909 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
2910
2911 =item *
2912
2913 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
2914
2915 =item *
2916
2917 C<home> - The application home directory. In an uninstalled application,
2918 this is the top level application directory. In an installed application,
2919 this will be the directory containing C<< MyApp.pm >>.
2920
2921 =item *
2922
2923 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
2924
2925 =item *
2926
2927 C<name> - The name of the application in debug messages and the debug and
2928 welcome screens
2929
2930 =item *
2931
2932 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
2933 until it is accessed. This allows you to (for example) check authentication (and reject
2934 the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
2935
2936 =item *
2937
2938 C<root> - The root directory for templates. Usually this is just a
2939 subdirectory of the home directory, but you can set it to change the
2940 templates to a different directory.
2941
2942 =item *
2943
2944 C<search_extra> - Array reference passed to Module::Pluggable to for additional
2945 namespaces from which components will be loaded (and constructed and stored in
2946 C<< $c->components >>).
2947
2948 =item *
2949
2950 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
2951 to be shown in hit debug tables in the test server.
2952
2953 =item *
2954
2955 C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
2956 variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
2957 for more information.
2958
2959 =item *
2960
2961 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
2962
2963 =back
2964
2965 =head1 INTERNAL ACTIONS
2966
2967 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2968 C<_ACTION>, and C<_END>. These are by default not shown in the private
2969 action table, but you can make them visible with a config parameter.
2970
2971     MyApp->config(show_internal_actions => 1);
2972
2973 =head1 ON-DEMAND PARSER
2974
2975 The request body is usually parsed at the beginning of a request,
2976 but if you want to handle input yourself, you can enable on-demand
2977 parsing with a config parameter.
2978
2979     MyApp->config(parse_on_demand => 1);
2980
2981 =head1 PROXY SUPPORT
2982
2983 Many production servers operate using the common double-server approach,
2984 with a lightweight frontend web server passing requests to a larger
2985 backend server. An application running on the backend server must deal
2986 with two problems: the remote user always appears to be C<127.0.0.1> and
2987 the server's hostname will appear to be C<localhost> regardless of the
2988 virtual host that the user connected through.
2989
2990 Catalyst will automatically detect this situation when you are running
2991 the frontend and backend servers on the same machine. The following
2992 changes are made to the request.
2993
2994     $c->req->address is set to the user's real IP address, as read from
2995     the HTTP X-Forwarded-For header.
2996
2997     The host value for $c->req->base and $c->req->uri is set to the real
2998     host, as read from the HTTP X-Forwarded-Host header.
2999
3000 Additionally, you may be running your backend application on an insecure
3001 connection (port 80) while your frontend proxy is running under SSL.  If there
3002 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3003 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3004 be created properly.
3005
3006 In the case of passing in:
3007
3008     X-Forwarded-Port: 443
3009
3010 All calls to C<uri_for> will result in an https link, as is expected.
3011
3012 Obviously, your web server must support these headers for this to work.
3013
3014 In a more complex server farm environment where you may have your
3015 frontend proxy server(s) on different machines, you will need to set a
3016 configuration option to tell Catalyst to read the proxied data from the
3017 headers.
3018
3019     MyApp->config(using_frontend_proxy => 1);
3020
3021 If you do not wish to use the proxy support at all, you may set:
3022
3023     MyApp->config(ignore_frontend_proxy => 1);
3024
3025 =head1 THREAD SAFETY
3026
3027 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3028 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3029 believe the Catalyst core to be thread-safe.
3030
3031 If you plan to operate in a threaded environment, remember that all other
3032 modules you are using must also be thread-safe. Some modules, most notably
3033 L<DBD::SQLite>, are not thread-safe.
3034
3035 =head1 SUPPORT
3036
3037 IRC:
3038
3039     Join #catalyst on irc.perl.org.
3040
3041 Mailing Lists:
3042
3043     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
3044     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
3045
3046 Web:
3047
3048     http://catalyst.perl.org
3049
3050 Wiki:
3051
3052     http://dev.catalyst.perl.org
3053
3054 =head1 SEE ALSO
3055
3056 =head2 L<Task::Catalyst> - All you need to start with Catalyst
3057
3058 =head2 L<Catalyst::Manual> - The Catalyst Manual
3059
3060 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
3061
3062 =head2 L<Catalyst::Engine> - Core engine
3063
3064 =head2 L<Catalyst::Log> - Log class.
3065
3066 =head2 L<Catalyst::Request> - Request object
3067
3068 =head2 L<Catalyst::Response> - Response object
3069
3070 =head2 L<Catalyst::Test> - The test suite.
3071
3072 =head1 PROJECT FOUNDER
3073
3074 sri: Sebastian Riedel <sri@cpan.org>
3075
3076 =head1 CONTRIBUTORS
3077
3078 abw: Andy Wardley
3079
3080 acme: Leon Brocard <leon@astray.com>
3081
3082 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
3083
3084 Andrew Bramble
3085
3086 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
3087
3088 Andrew Ruthven
3089
3090 André Walker
3091
3092 andyg: Andy Grundman <andy@hybridized.org>
3093
3094 audreyt: Audrey Tang
3095
3096 bricas: Brian Cassidy <bricas@cpan.org>
3097
3098 Caelum: Rafael Kitover <rkitover@io.com>
3099
3100 chansen: Christian Hansen
3101
3102 chicks: Christopher Hicks
3103
3104 Chisel Wright C<pause@herlpacker.co.uk>
3105
3106 Danijel Milicevic C<me@danijel.de>
3107
3108 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
3109
3110 David Naughton, C<naughton@umn.edu>
3111
3112 David E. Wheeler
3113
3114 dhoss: Devin Austin <dhoss@cpan.org>
3115
3116 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
3117
3118 Drew Taylor
3119
3120 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
3121
3122 esskar: Sascha Kiefer
3123
3124 fireartist: Carl Franks <cfranks@cpan.org>
3125
3126 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
3127
3128 gabb: Danijel Milicevic
3129
3130 Gary Ashton Jones
3131
3132 Gavin Henry C<ghenry@perl.me.uk>
3133
3134 Geoff Richards
3135
3136 groditi: Guillermo Roditi <groditi@gmail.com>
3137
3138 hobbs: Andrew Rodland <andrew@cleverdomain.org>
3139
3140 ilmari: Dagfinn Ilmari MannsÃ¥ker <ilmari@ilmari.org>
3141
3142 jcamacho: Juan Camacho
3143
3144 jester: Jesse Sheidlower C<jester@panix.com>
3145
3146 jhannah: Jay Hannah <jay@jays.net>
3147
3148 Jody Belka
3149
3150 Johan Lindstrom
3151
3152 jon: Jon Schutz <jjschutz@cpan.org>
3153
3154 Jonathan Rockway C<< <jrockway@cpan.org> >>
3155
3156 Kieren Diment C<kd@totaldatasolution.com>
3157
3158 konobi: Scott McWhirter <konobi@cpan.org>
3159
3160 marcus: Marcus Ramberg <mramberg@cpan.org>
3161
3162 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
3163
3164 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
3165
3166 mugwump: Sam Vilain
3167
3168 naughton: David Naughton
3169
3170 ningu: David Kamholz <dkamholz@cpan.org>
3171
3172 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
3173
3174 numa: Dan Sully <daniel@cpan.org>
3175
3176 obra: Jesse Vincent
3177
3178 Octavian Rasnita
3179
3180 omega: Andreas Marienborg
3181
3182 Oleg Kostyuk <cub.uanic@gmail.com>
3183
3184 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
3185
3186 rafl: Florian Ragwitz <rafl@debian.org>
3187
3188 random: Roland Lammel <lammel@cpan.org>
3189
3190 Robert Sedlacek C<< <rs@474.at> >>
3191
3192 SpiceMan: Marcel Montes
3193
3194 sky: Arthur Bergman
3195
3196 szbalint: Balint Szilakszi <szbalint@cpan.org>
3197
3198 t0m: Tomas Doran <bobtfish@bobtfish.net>
3199
3200 Ulf Edvinsson
3201
3202 Viljo Marrandi C<vilts@yahoo.com>
3203
3204 Will Hawes C<info@whawes.co.uk>
3205
3206 willert: Sebastian Willert <willert@cpan.org>
3207
3208 wreis: Wallace Reis <wallace@reis.org.br>
3209
3210 Yuval Kogman, C<nothingmuch@woobling.org>
3211
3212 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
3213
3214 dd070: Dhaval Dhanani <dhaval070@gmail.com>
3215
3216 =head1 COPYRIGHT
3217
3218 Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
3219
3220 =head1 LICENSE
3221
3222 This library is free software. You can redistribute it and/or modify it under
3223 the same terms as Perl itself.
3224
3225 =cut
3226
3227 no Moose;
3228
3229 __PACKAGE__->meta->make_immutable;
3230
3231 1;