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