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