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