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