evolve the stash middleware a bit. add a test case for tracking future growth
[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 namespace::clean -except => 'meta';
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 Module::Pluggable::Object ();
20 use Text::SimpleTable ();
21 use Path::Class::Dir ();
22 use Path::Class::File ();
23 use URI ();
24 use URI::http;
25 use URI::https;
26 use HTML::Entities;
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 Catalyst::EngineLoader;
34 use utf8;
35 use Carp qw/croak carp shortmess/;
36 use Try::Tiny;
37 use Safe::Isa;
38 use Moose::Util 'find_meta';
39 use Plack::Middleware::Conditional;
40 use Plack::Middleware::ReverseProxy;
41 use Plack::Middleware::IIS6ScriptNameFix;
42 use Plack::Middleware::IIS7KeepAliveFix;
43 use Plack::Middleware::LighttpdScriptNameFix;
44 use Plack::Middleware::ContentLength;
45 use Plack::Middleware::Head;
46 use Plack::Middleware::HTTPExceptions;
47 use Plack::Middleware::FixMissingBodyInRedirect;
48 use Plack::Middleware::MethodOverride;
49 use Plack::Middleware::RemoveRedundantBody;
50 use Catalyst::Middleware::Stash;
51 use Plack::Util;
52 use Class::Load 'load_class';
53 use Encode 2.21 ();
54
55 BEGIN { require 5.008003; }
56
57 has stack => (is => 'ro', default => sub { [] });
58 has state => (is => 'rw', default => 0);
59 has stats => (is => 'rw');
60 has action => (is => 'rw');
61 has counter => (is => 'rw', default => sub { {} });
62 has request => (
63     is => 'rw',
64     default => sub {
65         my $self = shift;
66         $self->request_class->new($self->_build_request_constructor_args);
67     },
68     lazy => 1,
69 );
70 sub _build_request_constructor_args {
71     my $self = shift;
72     my %p = ( _log => $self->log );
73     $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
74     $p{data_handlers} = {$self->registered_data_handlers};
75     $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
76       if $self->config->{use_hash_multivalue_in_request};
77     \%p;
78 }
79
80 has response => (
81     is => 'rw',
82     default => sub {
83         my $self = shift;
84         $self->response_class->new($self->_build_response_constructor_args);
85     },
86     lazy => 1,
87 );
88 sub _build_response_constructor_args {
89     my $self = shift;
90     { _log => $self->log };
91 }
92
93 has namespace => (is => 'rw');
94
95 sub depth { scalar @{ shift->stack || [] }; }
96 sub comp { shift->component(@_) }
97
98 sub req {
99     my $self = shift; return $self->request(@_);
100 }
101 sub res {
102     my $self = shift; return $self->response(@_);
103 }
104
105 # For backwards compatibility
106 sub finalize_output { shift->finalize_body(@_) };
107
108 # For statistics
109 our $COUNT     = 1;
110 our $START     = time;
111 our $RECURSION = 1000;
112 our $DETACH    = Catalyst::Exception::Detach->new;
113 our $GO        = Catalyst::Exception::Go->new;
114
115 #I imagine that very few of these really need to be class variables. if any.
116 #maybe we should just make them attributes with a default?
117 __PACKAGE__->mk_classdata($_)
118   for qw/components arguments dispatcher engine log dispatcher_class
119   engine_loader context_class request_class response_class stats_class
120   setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
121   _data_handlers _encoding _encode_check/;
122
123 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
124 __PACKAGE__->request_class('Catalyst::Request');
125 __PACKAGE__->response_class('Catalyst::Response');
126 __PACKAGE__->stats_class('Catalyst::Stats');
127 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
128
129 # Remember to update this in Catalyst::Runtime as well!
130 our $VERSION = '5.90080_001';
131
132 sub import {
133     my ( $class, @arguments ) = @_;
134
135     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
136     # callers @ISA.
137     return unless $class eq 'Catalyst';
138
139     my $caller = caller();
140     return if $caller eq 'main';
141
142     my $meta = Moose::Meta::Class->initialize($caller);
143     unless ( $caller->isa('Catalyst') ) {
144         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
145         $meta->superclasses(@superclasses);
146     }
147     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
148     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
149
150     unless( $meta->has_method('meta') ){
151         if ($Moose::VERSION >= 1.15) {
152             $meta->_add_meta_method('meta');
153         }
154         else {
155             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
156         }
157     }
158
159     $caller->arguments( [@arguments] );
160     $caller->setup_home;
161 }
162
163 sub _application { $_[0] }
164
165 =encoding UTF-8
166
167 =head1 NAME
168
169 Catalyst - The Elegant MVC Web Application Framework
170
171 =head1 SYNOPSIS
172
173 See the L<Catalyst::Manual> distribution for comprehensive
174 documentation and tutorials.
175
176     # Install Catalyst::Devel for helpers and other development tools
177     # use the helper to create a new application
178     catalyst.pl MyApp
179
180     # add models, views, controllers
181     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
182     script/myapp_create.pl view MyTemplate TT
183     script/myapp_create.pl controller Search
184
185     # built in testserver -- use -r to restart automatically on changes
186     # --help to see all available options
187     script/myapp_server.pl
188
189     # command line testing interface
190     script/myapp_test.pl /yada
191
192     ### in lib/MyApp.pm
193     use Catalyst qw/-Debug/; # include plugins here as well
194
195     ### In lib/MyApp/Controller/Root.pm (autocreated)
196     sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
197         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
198         $c->stash->{template} = 'foo.tt'; # set the template
199         # lookup something from db -- stash vars are passed to TT
200         $c->stash->{data} =
201           $c->model('Database::Foo')->search( { country => $args[0] } );
202         if ( $c->req->params->{bar} ) { # access GET or POST parameters
203             $c->forward( 'bar' ); # process another action
204             # do something else after forward returns
205         }
206     }
207
208     # The foo.tt TT template can use the stash data from the database
209     [% WHILE (item = data.next) %]
210         [% item.foo %]
211     [% END %]
212
213     # called for /bar/of/soap, /bar/of/soap/10, etc.
214     sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
215
216     # called after all actions are finished
217     sub end : Action {
218         my ( $self, $c ) = @_;
219         if ( scalar @{ $c->error } ) { ... } # handle errors
220         return if $c->res->body; # already have a response
221         $c->forward( 'MyApp::View::TT' ); # render template
222     }
223
224 See L<Catalyst::Manual::Intro> for additional information.
225
226 =head1 DESCRIPTION
227
228 Catalyst is a modern framework for making web applications without the
229 pain usually associated with this process. This document is a reference
230 to the main Catalyst application. If you are a new user, we suggest you
231 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
232
233 See L<Catalyst::Manual> for more documentation.
234
235 Catalyst plugins can be loaded by naming them as arguments to the "use
236 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
237 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
238 C<My::Module>.
239
240     use Catalyst qw/My::Module/;
241
242 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
243 fully qualify the name by using a unary plus:
244
245     use Catalyst qw/
246         My::Module
247         +Fully::Qualified::Plugin::Name
248     /;
249
250 Special flags like C<-Debug> can also be specified as
251 arguments when Catalyst is loaded:
252
253     use Catalyst qw/-Debug My::Module/;
254
255 The position of plugins and flags in the chain is important, because
256 they are loaded in the order in which they appear.
257
258 The following flags are supported:
259
260 =head2 -Debug
261
262 Enables debug output. You can also force this setting from the system
263 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
264 settings override the application, with <MYAPP>_DEBUG having the highest
265 priority.
266
267 This sets the log level to 'debug' and enables full debug output on the
268 error screen. If you only want the latter, see L<< $c->debug >>.
269
270 =head2 -Home
271
272 Forces Catalyst to use a specific home directory, e.g.:
273
274     use Catalyst qw[-Home=/usr/mst];
275
276 This can also be done in the shell environment by setting either the
277 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
278 is replaced with the uppercased name of your application, any "::" in
279 the name will be replaced with underscores, e.g. MyApp::Web should use
280 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
281
282 If none of these are set, Catalyst will attempt to automatically detect the
283 home directory. If you are working in a development environment, Catalyst
284 will try and find the directory containing either Makefile.PL, Build.PL,
285 dist.ini, or cpanfile. If the application has been installed into the system
286 (i.e. you have done C<make install>), then Catalyst will use the path to your
287 application module, without the .pm extension (e.g., /foo/MyApp if your
288 application was installed at /foo/MyApp.pm)
289
290 =head2 -Log
291
292     use Catalyst '-Log=warn,fatal,error';
293
294 Specifies a comma-delimited list of log levels.
295
296 =head2 -Stats
297
298 Enables statistics collection and reporting.
299
300    use Catalyst qw/-Stats=1/;
301
302 You can also force this setting from the system environment with CATALYST_STATS
303 or <MYAPP>_STATS. The environment settings override the application, with
304 <MYAPP>_STATS having the highest priority.
305
306 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
307
308 =head1 METHODS
309
310 =head2 INFORMATION ABOUT THE CURRENT REQUEST
311
312 =head2 $c->action
313
314 Returns a L<Catalyst::Action> object for the current action, which
315 stringifies to the action name. See L<Catalyst::Action>.
316
317 =head2 $c->namespace
318
319 Returns the namespace of the current action, i.e., the URI prefix
320 corresponding to the controller of the current action. For example:
321
322     # in Controller::Foo::Bar
323     $c->namespace; # returns 'foo/bar';
324
325 =head2 $c->request
326
327 =head2 $c->req
328
329 Returns the current L<Catalyst::Request> object, giving access to
330 information about the current client request (including parameters,
331 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
332
333 =head2 REQUEST FLOW HANDLING
334
335 =head2 $c->forward( $action [, \@arguments ] )
336
337 =head2 $c->forward( $class, $method, [, \@arguments ] )
338
339 This is one way of calling another action (method) in the same or
340 a different controller. You can also use C<< $self->my_method($c, @args) >>
341 in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
342 in a different controller.
343 The main difference is that 'forward' uses some of the Catalyst request
344 cycle overhead, including debugging, which may be useful to you. On the
345 other hand, there are some complications to using 'forward', restrictions
346 on values returned from 'forward', and it may not handle errors as you prefer.
347 Whether you use 'forward' or not is up to you; it is not considered superior to
348 the other ways to call a method.
349
350 'forward' calls  another action, by its private name. If you give a
351 class name but no method, C<process()> is called. You may also optionally
352 pass arguments in an arrayref. The action will receive the arguments in
353 C<@_> and C<< $c->req->args >>. Upon returning from the function,
354 C<< $c->req->args >> will be restored to the previous values.
355
356 Any data C<return>ed from the action forwarded to, will be returned by the
357 call to forward.
358
359     my $foodata = $c->forward('/foo');
360     $c->forward('index');
361     $c->forward(qw/Model::DBIC::Foo do_stuff/);
362     $c->forward('View::TT');
363
364 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
365 an C<< eval { } >> around the call (actually
366 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
367 exceptions thrown by the called action non-fatal and pushing them onto
368 $c->error instead. If you want C<die> to propagate you need to do something
369 like:
370
371     $c->forward('foo');
372     die join "\n", @{ $c->error } if @{ $c->error };
373
374 Or make sure to always return true values from your actions and write
375 your code like this:
376
377     $c->forward('foo') || return;
378
379 Another note is that C<< $c->forward >> always returns a scalar because it
380 actually returns $c->state which operates in a scalar context.
381 Thus, something like:
382
383     return @array;
384
385 in an action that is forwarded to is going to return a scalar,
386 i.e. how many items are in that array, which is probably not what you want.
387 If you need to return an array then return a reference to it,
388 or stash it like so:
389
390     $c->stash->{array} = \@array;
391
392 and access it from the stash.
393
394 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
395
396 =cut
397
398 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
399
400 =head2 $c->detach( $action [, \@arguments ] )
401
402 =head2 $c->detach( $class, $method, [, \@arguments ] )
403
404 =head2 $c->detach()
405
406 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
407 doesn't return to the previous action when processing is finished.
408
409 When called with no arguments it escapes the processing chain entirely.
410
411 =cut
412
413 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
414
415 =head2 $c->visit( $action [, \@arguments ] )
416
417 =head2 $c->visit( $action [, \@captures, \@arguments ] )
418
419 =head2 $c->visit( $class, $method, [, \@arguments ] )
420
421 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
422
423 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
424 but does a full dispatch, instead of just calling the new C<$action> /
425 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
426 you go to are called, just like a new request.
427
428 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
429 This means, for example, that C<< $c->action >> methods such as
430 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
431 L<reverse|Catalyst::Action/reverse> return information for the visited action
432 when they are invoked within the visited action.  This is different from the
433 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
434 continues to use the $c->action object from the caller action even when
435 invoked from the called action.
436
437 C<< $c->stash >> is kept unchanged.
438
439 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
440 allows you to "wrap" another action, just as it would have been called by
441 dispatching from a URL, while the analogous
442 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
443 transfer control to another action as if it had been reached directly from a URL.
444
445 =cut
446
447 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
448
449 =head2 $c->go( $action [, \@arguments ] )
450
451 =head2 $c->go( $action [, \@captures, \@arguments ] )
452
453 =head2 $c->go( $class, $method, [, \@arguments ] )
454
455 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
456
457 The relationship between C<go> and
458 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
459 the relationship between
460 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
461 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
462 C<< $c->go >> will perform a full dispatch on the specified action or method,
463 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
464 C<go> escapes the processing of the current request chain on completion, and
465 does not return to its caller.
466
467 @arguments are arguments to the final destination of $action. @captures are
468 arguments to the intermediate steps, if any, on the way to the final sub of
469 $action.
470
471 =cut
472
473 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
474
475 =head2 $c->response
476
477 =head2 $c->res
478
479 Returns the current L<Catalyst::Response> object, see there for details.
480
481 =head2 $c->stash
482
483 Returns a hashref to the stash, which may be used to store data and pass
484 it between components during a request. You can also set hash keys by
485 passing arguments. The stash is automatically sent to the view. The
486 stash is cleared at the end of a request; it cannot be used for
487 persistent storage (for this you must use a session; see
488 L<Catalyst::Plugin::Session> for a complete system integrated with
489 Catalyst).
490
491     $c->stash->{foo} = $bar;
492     $c->stash( { moose => 'majestic', qux => 0 } );
493     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
494
495     # stash is automatically passed to the view for use in a template
496     $c->forward( 'MyApp::View::TT' );
497
498 The stash hash is currently stored in the PSGI C<$env> and is managed by
499 L<Catalyst::Middleware::Stash>.  Since it's part of the C<$env> items in
500 the stash can be accessed in sub applications mounted under your main
501 L<Catalyst> application.  For example if you delegate the response of an
502 action to another L<Catalyst> application, that sub application will have
503 access to all the stash keys of the main one, and if can of course add
504 more keys of its own.  However those new keys will not 'bubble' back up
505 to the main application.
506
507 For more information the best thing to do is to review the test case:
508 t/middleware-stash.t in the distribution /t directory.
509
510 =cut
511
512 sub stash {
513   my $c = shift;
514   return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
515 }
516
517 =head2 $c->error
518
519 =head2 $c->error($error, ...)
520
521 =head2 $c->error($arrayref)
522
523 Returns an arrayref containing error messages.  If Catalyst encounters an
524 error while processing a request, it stores the error in $c->error.  This
525 method should only be used to store fatal error messages.
526
527     my @error = @{ $c->error };
528
529 Add a new error.
530
531     $c->error('Something bad happened');
532
533 =cut
534
535 sub error {
536     my $c = shift;
537     if ( $_[0] ) {
538         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
539         croak @$error unless ref $c;
540         push @{ $c->{error} }, @$error;
541     }
542     elsif ( defined $_[0] ) { $c->{error} = undef }
543     return $c->{error} || [];
544 }
545
546
547 =head2 $c->state
548
549 Contains the return value of the last executed action.
550 Note that << $c->state >> operates in a scalar context which means that all
551 values it returns are scalar.
552
553 =head2 $c->clear_errors
554
555 Clear errors.  You probably don't want to clear the errors unless you are
556 implementing a custom error screen.
557
558 This is equivalent to running
559
560     $c->error(0);
561
562 =cut
563
564 sub clear_errors {
565     my $c = shift;
566     $c->error(0);
567 }
568
569 =head2 $c->has_errors
570
571 Returns true if you have errors
572
573 =cut
574
575 sub has_errors { scalar(@{shift->error}) ? 1:0 }
576
577 sub _comp_search_prefixes {
578     my $c = shift;
579     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
580 }
581
582 # search components given a name and some prefixes
583 sub _comp_names_search_prefixes {
584     my ( $c, $name, @prefixes ) = @_;
585     my $appclass = ref $c || $c;
586     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
587     $filter = qr/$filter/; # Compile regex now rather than once per loop
588
589     # map the original component name to the sub part that we will search against
590     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
591         grep { /$filter/ } keys %{ $c->components };
592
593     # undef for a name will return all
594     return keys %eligible if !defined $name;
595
596     my $query  = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
597     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
598
599     return @result if @result;
600
601     # if we were given a regexp to search against, we're done.
602     return if $name->$_isa('Regexp');
603
604     # skip regexp fallback if configured
605     return
606         if $appclass->config->{disable_component_resolution_regex_fallback};
607
608     # regexp fallback
609     $query  = qr/$name/i;
610     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
611
612     # no results? try against full names
613     if( !@result ) {
614         @result = grep { m{$query} } keys %eligible;
615     }
616
617     # don't warn if we didn't find any results, it just might not exist
618     if( @result ) {
619         # Disgusting hack to work out correct method name
620         my $warn_for = lc $prefixes[0];
621         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
622            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
623            "component resolution is unreliable and unsafe.";
624         my $short = $result[0];
625         # remove the component namespace prefix
626         $short =~ s/.*?(Model|Controller|View):://;
627         my $shortmess = Carp::shortmess('');
628         if ($shortmess =~ m#Catalyst/Plugin#) {
629            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
630               "plugin's config";
631         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
632            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
633               "component's config";
634         } else {
635            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
636               "but if you really wanted to search, pass in a regexp as the argument " .
637               "like so: \$c->${warn_for}(qr/${name}/)";
638         }
639         $c->log->warn( "${msg}$shortmess" );
640     }
641
642     return @result;
643 }
644
645 # Find possible names for a prefix
646 sub _comp_names {
647     my ( $c, @prefixes ) = @_;
648     my $appclass = ref $c || $c;
649
650     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
651
652     my @names = map { s{$filter}{}; $_; }
653         $c->_comp_names_search_prefixes( undef, @prefixes );
654
655     return @names;
656 }
657
658 # Filter a component before returning by calling ACCEPT_CONTEXT if available
659 sub _filter_component {
660     my ( $c, $comp, @args ) = @_;
661
662     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
663         return $comp->ACCEPT_CONTEXT( $c, @args );
664     }
665
666     return $comp;
667 }
668
669 =head2 COMPONENT ACCESSORS
670
671 =head2 $c->controller($name)
672
673 Gets a L<Catalyst::Controller> instance by name.
674
675     $c->controller('Foo')->do_stuff;
676
677 If the name is omitted, will return the controller for the dispatched
678 action.
679
680 If you want to search for controllers, pass in a regexp as the argument.
681
682     # find all controllers that start with Foo
683     my @foo_controllers = $c->controller(qr{^Foo});
684
685
686 =cut
687
688 sub controller {
689     my ( $c, $name, @args ) = @_;
690
691     my $appclass = ref($c) || $c;
692     if( $name ) {
693         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
694             my $comps = $c->components;
695             my $check = $appclass."::Controller::".$name;
696             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
697         }
698         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
699         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
700         return $c->_filter_component( $result[ 0 ], @args );
701     }
702
703     return $c->component( $c->action->class );
704 }
705
706 =head2 $c->model($name)
707
708 Gets a L<Catalyst::Model> instance by name.
709
710     $c->model('Foo')->do_stuff;
711
712 Any extra arguments are directly passed to ACCEPT_CONTEXT.
713
714 If the name is omitted, it will look for
715  - a model object in $c->stash->{current_model_instance}, then
716  - a model name in $c->stash->{current_model}, then
717  - a config setting 'default_model', or
718  - check if there is only one model, and return it if that's the case.
719
720 If you want to search for models, pass in a regexp as the argument.
721
722     # find all models that start with Foo
723     my @foo_models = $c->model(qr{^Foo});
724
725 =cut
726
727 sub model {
728     my ( $c, $name, @args ) = @_;
729     my $appclass = ref($c) || $c;
730     if( $name ) {
731         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
732             my $comps = $c->components;
733             my $check = $appclass."::Model::".$name;
734             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
735         }
736         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
737         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
738         return $c->_filter_component( $result[ 0 ], @args );
739     }
740
741     if (ref $c) {
742         return $c->stash->{current_model_instance}
743           if $c->stash->{current_model_instance};
744         return $c->model( $c->stash->{current_model} )
745           if $c->stash->{current_model};
746     }
747     return $c->model( $appclass->config->{default_model} )
748       if $appclass->config->{default_model};
749
750     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
751
752     if( $rest ) {
753         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
754         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
755         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
756         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
757         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
758     }
759
760     return $c->_filter_component( $comp );
761 }
762
763
764 =head2 $c->view($name)
765
766 Gets a L<Catalyst::View> instance by name.
767
768     $c->view('Foo')->do_stuff;
769
770 Any extra arguments are directly passed to ACCEPT_CONTEXT.
771
772 If the name is omitted, it will look for
773  - a view object in $c->stash->{current_view_instance}, then
774  - a view name in $c->stash->{current_view}, then
775  - a config setting 'default_view', or
776  - check if there is only one view, and return it if that's the case.
777
778 If you want to search for views, pass in a regexp as the argument.
779
780     # find all views that start with Foo
781     my @foo_views = $c->view(qr{^Foo});
782
783 =cut
784
785 sub view {
786     my ( $c, $name, @args ) = @_;
787
788     my $appclass = ref($c) || $c;
789     if( $name ) {
790         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
791             my $comps = $c->components;
792             my $check = $appclass."::View::".$name;
793             if( exists $comps->{$check} ) {
794                 return $c->_filter_component( $comps->{$check}, @args );
795             }
796             else {
797                 $c->log->warn( "Attempted to use view '$check', but does not exist" );
798             }
799         }
800         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
801         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
802         return $c->_filter_component( $result[ 0 ], @args );
803     }
804
805     if (ref $c) {
806         return $c->stash->{current_view_instance}
807           if $c->stash->{current_view_instance};
808         return $c->view( $c->stash->{current_view} )
809           if $c->stash->{current_view};
810     }
811     return $c->view( $appclass->config->{default_view} )
812       if $appclass->config->{default_view};
813
814     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
815
816     if( $rest ) {
817         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
818         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
819         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
820         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
821         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
822     }
823
824     return $c->_filter_component( $comp );
825 }
826
827 =head2 $c->controllers
828
829 Returns the available names which can be passed to $c->controller
830
831 =cut
832
833 sub controllers {
834     my ( $c ) = @_;
835     return $c->_comp_names(qw/Controller C/);
836 }
837
838 =head2 $c->models
839
840 Returns the available names which can be passed to $c->model
841
842 =cut
843
844 sub models {
845     my ( $c ) = @_;
846     return $c->_comp_names(qw/Model M/);
847 }
848
849
850 =head2 $c->views
851
852 Returns the available names which can be passed to $c->view
853
854 =cut
855
856 sub views {
857     my ( $c ) = @_;
858     return $c->_comp_names(qw/View V/);
859 }
860
861 =head2 $c->comp($name)
862
863 =head2 $c->component($name)
864
865 Gets a component object by name. This method is not recommended,
866 unless you want to get a specific component by full
867 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
868 should be used instead.
869
870 If C<$name> is a regexp, a list of components matched against the full
871 component name will be returned.
872
873 If Catalyst can't find a component by name, it will fallback to regex
874 matching by default. To disable this behaviour set
875 disable_component_resolution_regex_fallback to a true value.
876
877     __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
878
879 =cut
880
881 sub component {
882     my ( $c, $name, @args ) = @_;
883
884     if( $name ) {
885         my $comps = $c->components;
886
887         if( !ref $name ) {
888             # is it the exact name?
889             return $c->_filter_component( $comps->{ $name }, @args )
890                        if exists $comps->{ $name };
891
892             # perhaps we just omitted "MyApp"?
893             my $composed = ( ref $c || $c ) . "::${name}";
894             return $c->_filter_component( $comps->{ $composed }, @args )
895                        if exists $comps->{ $composed };
896
897             # search all of the models, views and controllers
898             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
899             return $c->_filter_component( $comp, @args ) if $comp;
900         }
901
902         return
903             if $c->config->{disable_component_resolution_regex_fallback};
904
905         # This is here so $c->comp( '::M::' ) works
906         my $query = ref $name ? $name : qr{$name}i;
907
908         my @result = grep { m{$query} } keys %{ $c->components };
909         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
910
911         if( $result[ 0 ] ) {
912             $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
913             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
914             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
915             return $c->_filter_component( $result[ 0 ], @args );
916         }
917
918         # I would expect to return an empty list here, but that breaks back-compat
919     }
920
921     # fallback
922     return sort keys %{ $c->components };
923 }
924
925 =head2 CLASS DATA AND HELPER CLASSES
926
927 =head2 $c->config
928
929 Returns or takes a hashref containing the application's configuration.
930
931     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
932
933 You can also use a C<YAML>, C<XML> or L<Config::General> config file
934 like C<myapp.conf> in your applications home directory. See
935 L<Catalyst::Plugin::ConfigLoader>.
936
937 =head3 Cascading configuration
938
939 The config method is present on all Catalyst components, and configuration
940 will be merged when an application is started. Configuration loaded with
941 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
942 followed by configuration in your top level C<MyApp> class. These two
943 configurations are merged, and then configuration data whose hash key matches a
944 component name is merged with configuration for that component.
945
946 The configuration for a component is then passed to the C<new> method when a
947 component is constructed.
948
949 For example:
950
951     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
952     MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
953
954 will mean that C<MyApp::Model::Foo> receives the following data when
955 constructed:
956
957     MyApp::Model::Foo->new({
958         bar => 'baz',
959         quux => 'frob',
960         overrides => 'me',
961     });
962
963 It's common practice to use a Moose attribute
964 on the receiving component to access the config value.
965
966     package MyApp::Model::Foo;
967
968     use Moose;
969
970     # this attr will receive 'baz' at construction time
971     has 'bar' => (
972         is  => 'rw',
973         isa => 'Str',
974     );
975
976 You can then get the value 'baz' by calling $c->model('Foo')->bar
977 (or $self->bar inside code in the model).
978
979 B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
980 as a way of reading config within your code, as this B<will not> give you the
981 correctly merged config back. You B<MUST> take the config values supplied to
982 the constructor and use those instead.
983
984 =cut
985
986 around config => sub {
987     my $orig = shift;
988     my $c = shift;
989
990     croak('Setting config after setup has been run is not allowed.')
991         if ( @_ and $c->setup_finished );
992
993     $c->$orig(@_);
994 };
995
996 =head2 $c->log
997
998 Returns the logging object instance. Unless it is already set, Catalyst
999 sets this up with a L<Catalyst::Log> object. To use your own log class,
1000 set the logger with the C<< __PACKAGE__->log >> method prior to calling
1001 C<< __PACKAGE__->setup >>.
1002
1003  __PACKAGE__->log( MyLogger->new );
1004  __PACKAGE__->setup;
1005
1006 And later:
1007
1008     $c->log->info( 'Now logging with my own logger!' );
1009
1010 Your log class should implement the methods described in
1011 L<Catalyst::Log>.
1012
1013 =head2 encoding
1014
1015 Sets or gets the application encoding.
1016
1017 =cut
1018
1019 sub encoding {
1020     my $c = shift;
1021     my $encoding;
1022
1023     if ( scalar @_ ) {
1024         # Let it be set to undef
1025         if (my $wanted = shift)  {
1026             $encoding = Encode::find_encoding($wanted)
1027               or Carp::croak( qq/Unknown encoding '$wanted'/ );
1028             binmode(STDERR, ':encoding(' . $encoding->name . ')');
1029         }
1030         else {
1031             binmode(STDERR);
1032         }
1033
1034         $encoding = ref $c
1035                   ? $c->{encoding} = $encoding
1036                   : $c->_encoding($encoding);
1037     } else {
1038       $encoding = ref $c && exists $c->{encoding}
1039                 ? $c->{encoding}
1040                 : $c->_encoding;
1041     }
1042
1043     return $encoding;
1044 }
1045
1046 =head2 $c->debug
1047
1048 Returns 1 if debug mode is enabled, 0 otherwise.
1049
1050 You can enable debug mode in several ways:
1051
1052 =over
1053
1054 =item By calling myapp_server.pl with the -d flag
1055
1056 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
1057
1058 =item The -Debug option in your MyApp.pm
1059
1060 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
1061
1062 =back
1063
1064 The first three also set the log level to 'debug'.
1065
1066 Calling C<< $c->debug(1) >> has no effect.
1067
1068 =cut
1069
1070 sub debug { 0 }
1071
1072 =head2 $c->dispatcher
1073
1074 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
1075
1076 =head2 $c->engine
1077
1078 Returns the engine instance. See L<Catalyst::Engine>.
1079
1080
1081 =head2 UTILITY METHODS
1082
1083 =head2 $c->path_to(@path)
1084
1085 Merges C<@path> with C<< $c->config->{home} >> and returns a
1086 L<Path::Class::Dir> object. Note you can usually use this object as
1087 a filename, but sometimes you will have to explicitly stringify it
1088 yourself by calling the C<< ->stringify >> method.
1089
1090 For example:
1091
1092     $c->path_to( 'db', 'sqlite.db' );
1093
1094 =cut
1095
1096 sub path_to {
1097     my ( $c, @path ) = @_;
1098     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
1099     if ( -d $path ) { return $path }
1100     else { return Path::Class::File->new( $c->config->{home}, @path ) }
1101 }
1102
1103 sub plugin {
1104     my ( $class, $name, $plugin, @args ) = @_;
1105
1106     # See block comment in t/unit_core_plugin.t
1107     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
1108
1109     $class->_register_plugin( $plugin, 1 );
1110
1111     eval { $plugin->import };
1112     $class->mk_classdata($name);
1113     my $obj;
1114     eval { $obj = $plugin->new(@args) };
1115
1116     if ($@) {
1117         Catalyst::Exception->throw( message =>
1118               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1119     }
1120
1121     $class->$name($obj);
1122     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1123       if $class->debug;
1124 }
1125
1126 =head2 MyApp->setup
1127
1128 Initializes the dispatcher and engine, loads any plugins, and loads the
1129 model, view, and controller components. You may also specify an array
1130 of plugins to load here, if you choose to not load them in the C<use
1131 Catalyst> line.
1132
1133     MyApp->setup;
1134     MyApp->setup( qw/-Debug/ );
1135
1136 B<Note:> You B<should not> wrap this method with method modifiers
1137 or bad things will happen - wrap the C<setup_finalize> method instead.
1138
1139 =cut
1140
1141 sub setup {
1142     my ( $class, @arguments ) = @_;
1143     croak('Running setup more than once')
1144         if ( $class->setup_finished );
1145
1146     unless ( $class->isa('Catalyst') ) {
1147
1148         Catalyst::Exception->throw(
1149             message => qq/'$class' does not inherit from Catalyst/ );
1150     }
1151
1152     if ( $class->arguments ) {
1153         @arguments = ( @arguments, @{ $class->arguments } );
1154     }
1155
1156     # Process options
1157     my $flags = {};
1158
1159     foreach (@arguments) {
1160
1161         if (/^-Debug$/) {
1162             $flags->{log} =
1163               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1164         }
1165         elsif (/^-(\w+)=?(.*)$/) {
1166             $flags->{ lc $1 } = $2;
1167         }
1168         else {
1169             push @{ $flags->{plugins} }, $_;
1170         }
1171     }
1172
1173     $class->setup_home( delete $flags->{home} );
1174
1175     $class->setup_log( delete $flags->{log} );
1176     $class->setup_plugins( delete $flags->{plugins} );
1177
1178     $class->setup_data_handlers();
1179     $class->setup_dispatcher( delete $flags->{dispatcher} );
1180     if (my $engine = delete $flags->{engine}) {
1181         $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
1182     }
1183     $class->setup_engine();
1184     $class->setup_stats( delete $flags->{stats} );
1185
1186     for my $flag ( sort keys %{$flags} ) {
1187
1188         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1189             &$code( $class, delete $flags->{$flag} );
1190         }
1191         else {
1192             $class->log->warn(qq/Unknown flag "$flag"/);
1193         }
1194     }
1195
1196     eval { require Catalyst::Devel; };
1197     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1198         $class->log->warn(<<"EOF");
1199 You are running an old script!
1200
1201   Please update by running (this will overwrite existing files):
1202     catalyst.pl -force -scripts $class
1203
1204   or (this will not overwrite existing files):
1205     catalyst.pl -scripts $class
1206
1207 EOF
1208     }
1209
1210     # Call plugins setup, this is stupid and evil.
1211     # Also screws C3 badly on 5.10, hack to avoid.
1212     {
1213         no warnings qw/redefine/;
1214         local *setup = sub { };
1215         $class->setup unless $Catalyst::__AM_RESTARTING;
1216     }
1217
1218     # If you are expecting configuration info as part of your setup, it needs
1219     # to get called here and below, since we need the above line to support
1220     # ConfigLoader based configs.
1221
1222     $class->setup_encoding();
1223     $class->setup_middleware();
1224
1225     # Initialize our data structure
1226     $class->components( {} );
1227
1228     $class->setup_components;
1229
1230     if ( $class->debug ) {
1231         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1232
1233         if (@plugins) {
1234             my $column_width = Catalyst::Utils::term_width() - 6;
1235             my $t = Text::SimpleTable->new($column_width);
1236             $t->row($_) for @plugins;
1237             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1238         }
1239
1240         my @middleware = map {
1241           ref $_ eq 'CODE' ? 
1242             "Inline Coderef" : 
1243               (ref($_) .'  '. ($_->can('VERSION') ? $_->VERSION || '' : '') 
1244                 || '')  } $class->registered_middlewares;
1245
1246         if (@middleware) {
1247             my $column_width = Catalyst::Utils::term_width() - 6;
1248             my $t = Text::SimpleTable->new($column_width);
1249             $t->row($_) for @middleware;
1250             $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1251         }
1252
1253         my %dh = $class->registered_data_handlers;
1254         if (my @data_handlers = keys %dh) {
1255             my $column_width = Catalyst::Utils::term_width() - 6;
1256             my $t = Text::SimpleTable->new($column_width);
1257             $t->row($_) for @data_handlers;
1258             $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1259         }
1260
1261         my $dispatcher = $class->dispatcher;
1262         my $engine     = $class->engine;
1263         my $home       = $class->config->{home};
1264
1265         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1266         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1267
1268         $home
1269           ? ( -d $home )
1270           ? $class->log->debug(qq/Found home "$home"/)
1271           : $class->log->debug(qq/Home "$home" doesn't exist/)
1272           : $class->log->debug(q/Couldn't find home/);
1273
1274         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1275         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1276         for my $comp ( sort keys %{ $class->components } ) {
1277             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1278             $t->row( $comp, $type );
1279         }
1280         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1281           if ( keys %{ $class->components } );
1282     }
1283
1284     # Add our self to components, since we are also a component
1285     if( $class->isa('Catalyst::Controller') ){
1286       $class->components->{$class} = $class;
1287     }
1288
1289     $class->setup_actions;
1290
1291     if ( $class->debug ) {
1292         my $name = $class->config->{name} || 'Application';
1293         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1294     }
1295
1296     if ($class->config->{case_sensitive}) {
1297         $class->log->warn($class . "->config->{case_sensitive} is set.");
1298         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1299     }
1300
1301     $class->setup_finalize;
1302
1303     # Flush the log for good measure (in case something turned off 'autoflush' early)
1304     $class->log->_flush() if $class->log->can('_flush');
1305
1306     return $class || 1; # Just in case someone named their Application 0...
1307 }
1308
1309 =head2 $app->setup_finalize
1310
1311 A hook to attach modifiers to. This method does not do anything except set the
1312 C<setup_finished> accessor.
1313
1314 Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
1315
1316 Example:
1317
1318     after setup_finalize => sub {
1319         my $app = shift;
1320
1321         ## do stuff here..
1322     };
1323
1324 =cut
1325
1326 sub setup_finalize {
1327     my ($class) = @_;
1328     $class->setup_finished(1);
1329 }
1330
1331 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1332
1333 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1334
1335 Constructs an absolute L<URI> object based on the application root, the
1336 provided path, and the additional arguments and query parameters provided.
1337 When used as a string, provides a textual URI.  If you need more flexibility
1338 than this (i.e. the option to provide relative URIs etc.) see
1339 L<Catalyst::Plugin::SmartURI>.
1340
1341 If no arguments are provided, the URI for the current action is returned.
1342 To return the current action and also provide @args, use
1343 C<< $c->uri_for( $c->action, @args ) >>.
1344
1345 If the first argument is a string, it is taken as a public URI path relative
1346 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1347 relative to the application root (if it does). It is then merged with
1348 C<< $c->request->base >>; any C<@args> are appended as additional path
1349 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1350
1351 If the first argument is a L<Catalyst::Action> it represents an action which
1352 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1353 optional C<\@captures> argument (an arrayref) allows passing the captured
1354 variables that are needed to fill in the paths of Chained and Regex actions;
1355 once the path is resolved, C<uri_for> continues as though a path was
1356 provided, appending any arguments or parameters and creating an absolute
1357 URI.
1358
1359 The captures for the current request can be found in
1360 C<< $c->request->captures >>, and actions can be resolved using
1361 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1362 path, use C<< $c->uri_for_action >> instead.
1363
1364   # Equivalent to $c->req->uri
1365   $c->uri_for($c->action, $c->req->captures,
1366       @{ $c->req->args }, $c->req->params);
1367
1368   # For the Foo action in the Bar controller
1369   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1370
1371   # Path to a static resource
1372   $c->uri_for('/static/images/logo.png');
1373
1374 =cut
1375
1376 sub uri_for {
1377     my ( $c, $path, @args ) = @_;
1378
1379     if ( $path->$_isa('Catalyst::Controller') ) {
1380         $path = $path->path_prefix;
1381         $path =~ s{/+\z}{};
1382         $path .= '/';
1383     }
1384
1385     undef($path) if (defined $path && $path eq '');
1386
1387     my $params =
1388       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1389
1390     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1391     foreach my $arg (@args) {
1392         utf8::encode($arg) if utf8::is_utf8($arg);
1393         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1394     }
1395
1396     if ( $path->$_isa('Catalyst::Action') ) { # action object
1397         s|/|%2F|g for @args;
1398         my $captures = [ map { s|/|%2F|g; $_; }
1399                         ( scalar @args && ref $args[0] eq 'ARRAY'
1400                          ? @{ shift(@args) }
1401                          : ()) ];
1402
1403         foreach my $capture (@$captures) {
1404             utf8::encode($capture) if utf8::is_utf8($capture);
1405             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1406         }
1407
1408         my $action = $path;
1409         # ->uri_for( $action, \@captures_and_args, \%query_values? )
1410         if( !@args && $action->number_of_args ) {
1411             my $expanded_action = $c->dispatcher->expand_action( $action );
1412
1413             my $num_captures = $expanded_action->number_of_captures;
1414             unshift @args, splice @$captures, $num_captures;
1415         }
1416
1417        $path = $c->dispatcher->uri_for_action($action, $captures);
1418         if (not defined $path) {
1419             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1420                 if $c->debug;
1421             return undef;
1422         }
1423         $path = '/' if $path eq '';
1424     }
1425
1426     unshift(@args, $path);
1427
1428     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1429         my $namespace = $c->namespace;
1430         if (defined $path) { # cheesy hack to handle path '../foo'
1431            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1432         }
1433         unshift(@args, $namespace || '');
1434     }
1435
1436     # join args with '/', or a blank string
1437     my $args = join('/', grep { defined($_) } @args);
1438     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1439     $args =~ s!^/+!!;
1440
1441     my ($base, $class) = ('/', 'URI::_generic');
1442     if(blessed($c)) {
1443       $base = $c->req->base;
1444       $class = ref($base);
1445       $base =~ s{(?<!/)$}{/};
1446     }
1447
1448     my $query = '';
1449
1450     if (my @keys = keys %$params) {
1451       # somewhat lifted from URI::_query's query_form
1452       $query = '?'.join('&', map {
1453           my $val = $params->{$_};
1454           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1455           s/ /+/g;
1456           my $key = $_;
1457           $val = '' unless defined $val;
1458           (map {
1459               my $param = "$_";
1460               utf8::encode( $param ) if utf8::is_utf8($param);
1461               # using the URI::Escape pattern here so utf8 chars survive
1462               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1463               $param =~ s/ /+/g;
1464               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1465       } @keys);
1466     }
1467
1468     my $res = bless(\"${base}${args}${query}", $class);
1469     $res;
1470 }
1471
1472 =head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
1473
1474 =head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
1475
1476 =over
1477
1478 =item $path
1479
1480 A private path to the Catalyst action you want to create a URI for.
1481
1482 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1483 >> and passing the resulting C<$action> and the remaining arguments to C<<
1484 $c->uri_for >>.
1485
1486 You can also pass in a Catalyst::Action object, in which case it is passed to
1487 C<< $c->uri_for >>.
1488
1489 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.
1490
1491 For example, if the action looks like:
1492
1493  package MyApp::Controller::Users;
1494
1495  sub lst : Path('the-list') {}
1496
1497 You can use:
1498
1499  $c->uri_for_action('/users/lst')
1500
1501 and it will create the URI /users/the-list.
1502
1503 =item \@captures_and_args?
1504
1505 Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1506 and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1507 to interpolate all the parameters in the URI.
1508
1509 =item @args?
1510
1511 Optional list of extra arguments - can be supplied in the
1512 C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1513 code.
1514
1515 Your action can have zero, a fixed or a variable number of args (e.g.
1516 C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
1517
1518 =item \%query_values?
1519
1520 Optional array reference of query parameters to append. E.g.
1521
1522   { foo => 'bar' }
1523
1524 will generate
1525
1526   /rest/of/your/uri?foo=bar
1527
1528 =back
1529
1530 =cut
1531
1532 sub uri_for_action {
1533     my ( $c, $path, @args ) = @_;
1534     my $action = blessed($path)
1535       ? $path
1536       : $c->dispatcher->get_action_by_path($path);
1537     unless (defined $action) {
1538       croak "Can't find action for path '$path'";
1539     }
1540     return $c->uri_for( $action, @args );
1541 }
1542
1543 =head2 $c->welcome_message
1544
1545 Returns the Catalyst welcome HTML page.
1546
1547 =cut
1548
1549 sub welcome_message {
1550     my $c      = shift;
1551     my $name   = $c->config->{name};
1552     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1553     my $prefix = Catalyst::Utils::appprefix( ref $c );
1554     $c->response->content_type('text/html; charset=utf-8');
1555     return <<"EOF";
1556 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1557     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1558 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1559     <head>
1560     <meta http-equiv="Content-Language" content="en" />
1561     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1562         <title>$name on Catalyst $VERSION</title>
1563         <style type="text/css">
1564             body {
1565                 color: #000;
1566                 background-color: #eee;
1567             }
1568             div#content {
1569                 width: 640px;
1570                 margin-left: auto;
1571                 margin-right: auto;
1572                 margin-top: 10px;
1573                 margin-bottom: 10px;
1574                 text-align: left;
1575                 background-color: #ccc;
1576                 border: 1px solid #aaa;
1577             }
1578             p, h1, h2 {
1579                 margin-left: 20px;
1580                 margin-right: 20px;
1581                 font-family: verdana, tahoma, sans-serif;
1582             }
1583             a {
1584                 font-family: verdana, tahoma, sans-serif;
1585             }
1586             :link, :visited {
1587                     text-decoration: none;
1588                     color: #b00;
1589                     border-bottom: 1px dotted #bbb;
1590             }
1591             :link:hover, :visited:hover {
1592                     color: #555;
1593             }
1594             div#topbar {
1595                 margin: 0px;
1596             }
1597             pre {
1598                 margin: 10px;
1599                 padding: 8px;
1600             }
1601             div#answers {
1602                 padding: 8px;
1603                 margin: 10px;
1604                 background-color: #fff;
1605                 border: 1px solid #aaa;
1606             }
1607             h1 {
1608                 font-size: 0.9em;
1609                 font-weight: normal;
1610                 text-align: center;
1611             }
1612             h2 {
1613                 font-size: 1.0em;
1614             }
1615             p {
1616                 font-size: 0.9em;
1617             }
1618             p img {
1619                 float: right;
1620                 margin-left: 10px;
1621             }
1622             span#appname {
1623                 font-weight: bold;
1624                 font-size: 1.6em;
1625             }
1626         </style>
1627     </head>
1628     <body>
1629         <div id="content">
1630             <div id="topbar">
1631                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1632                     $VERSION</h1>
1633              </div>
1634              <div id="answers">
1635                  <p>
1636                  <img src="$logo" alt="Catalyst Logo" />
1637                  </p>
1638                  <p>Welcome to the  world of Catalyst.
1639                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1640                     framework will make web development something you had
1641                     never expected it to be: Fun, rewarding, and quick.</p>
1642                  <h2>What to do now?</h2>
1643                  <p>That really depends  on what <b>you</b> want to do.
1644                     We do, however, provide you with a few starting points.</p>
1645                  <p>If you want to jump right into web development with Catalyst
1646                     you might want to start with a tutorial.</p>
1647 <pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
1648 </pre>
1649 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1650 <pre>
1651 <code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
1652 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1653 </code></pre>
1654                  <h2>What to do next?</h2>
1655                  <p>Next it's time to write an actual application. Use the
1656                     helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1657                     <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1658                     <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
1659                     they can save you a lot of work.</p>
1660                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1661                     <p>Also, be sure to check out the vast and growing
1662                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1663                     you are likely to find what you need there.
1664                     </p>
1665
1666                  <h2>Need help?</h2>
1667                  <p>Catalyst has a very active community. Here are the main places to
1668                     get in touch with us.</p>
1669                  <ul>
1670                      <li>
1671                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1672                      </li>
1673                      <li>
1674                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1675                      </li>
1676                      <li>
1677                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1678                      </li>
1679                  </ul>
1680                  <h2>In conclusion</h2>
1681                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1682                     as we enjoyed making it. Please contact us if you have ideas
1683                     for improvement or other feedback.</p>
1684              </div>
1685          </div>
1686     </body>
1687 </html>
1688 EOF
1689 }
1690
1691 =head2 run_options
1692
1693 Contains a hash of options passed from the application script, including
1694 the original ARGV the script received, the processed values from that
1695 ARGV and any extra arguments to the script which were not processed.
1696
1697 This can be used to add custom options to your application's scripts
1698 and setup your application differently depending on the values of these
1699 options.
1700
1701 =head1 INTERNAL METHODS
1702
1703 These methods are not meant to be used by end users.
1704
1705 =head2 $c->components
1706
1707 Returns a hash of components.
1708
1709 =head2 $c->context_class
1710
1711 Returns or sets the context class.
1712
1713 =head2 $c->counter
1714
1715 Returns a hashref containing coderefs and execution counts (needed for
1716 deep recursion detection).
1717
1718 =head2 $c->depth
1719
1720 Returns the number of actions on the current internal execution stack.
1721
1722 =head2 $c->dispatch
1723
1724 Dispatches a request to actions.
1725
1726 =cut
1727
1728 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1729
1730 =head2 $c->dispatcher_class
1731
1732 Returns or sets the dispatcher class.
1733
1734 =head2 $c->dump_these
1735
1736 Returns a list of 2-element array references (name, structure) pairs
1737 that will be dumped on the error page in debug mode.
1738
1739 =cut
1740
1741 sub dump_these {
1742     my $c = shift;
1743     [ Request => $c->req ],
1744     [ Response => $c->res ],
1745     [ Stash => $c->stash ],
1746     [ Config => $c->config ];
1747 }
1748
1749 =head2 $c->engine_class
1750
1751 Returns or sets the engine class.
1752
1753 =head2 $c->execute( $class, $coderef )
1754
1755 Execute a coderef in given class and catch exceptions. Errors are available
1756 via $c->error.
1757
1758 =cut
1759
1760 sub execute {
1761     my ( $c, $class, $code ) = @_;
1762     $class = $c->component($class) || $class;
1763     $c->state(0);
1764
1765     if ( $c->depth >= $RECURSION ) {
1766         my $action = $code->reverse();
1767         $action = "/$action" unless $action =~ /->/;
1768         my $error = qq/Deep recursion detected calling "${action}"/;
1769         $c->log->error($error);
1770         $c->error($error);
1771         $c->state(0);
1772         return $c->state;
1773     }
1774
1775     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1776
1777     push( @{ $c->stack }, $code );
1778
1779     no warnings 'recursion';
1780     # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1781     #      I have no idea how, ergo $ret (which appears to fix the issue)
1782     eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
1783
1784     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1785
1786     my $last = pop( @{ $c->stack } );
1787
1788     if ( my $error = $@ ) {
1789         #rethow if this can be handled by middleware
1790         if(blessed $error && ($error->can('as_psgi') || $error->can('code'))) {
1791             foreach my $err (@{$c->error}) {
1792                 $c->log->error($err);
1793             }
1794             $c->clear_errors;
1795             $c->log->_flush if $c->log->can('_flush');
1796
1797             $error->can('rethrow') ? $error->rethrow : croak $error;
1798         }
1799         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1800             $error->rethrow if $c->depth > 1;
1801         }
1802         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1803             $error->rethrow if $c->depth > 0;
1804         }
1805         else {
1806             unless ( ref $error ) {
1807                 no warnings 'uninitialized';
1808                 chomp $error;
1809                 my $class = $last->class;
1810                 my $name  = $last->name;
1811                 $error = qq/Caught exception in $class->$name "$error"/;
1812             }
1813             $c->error($error);
1814         }
1815         $c->state(0);
1816     }
1817     return $c->state;
1818 }
1819
1820 sub _stats_start_execute {
1821     my ( $c, $code ) = @_;
1822     my $appclass = ref($c) || $c;
1823     return if ( ( $code->name =~ /^_.*/ )
1824         && ( !$appclass->config->{show_internal_actions} ) );
1825
1826     my $action_name = $code->reverse();
1827     $c->counter->{$action_name}++;
1828
1829     my $action = $action_name;
1830     $action = "/$action" unless $action =~ /->/;
1831
1832     # determine if the call was the result of a forward
1833     # this is done by walking up the call stack and looking for a calling
1834     # sub of Catalyst::forward before the eval
1835     my $callsub = q{};
1836     for my $index ( 2 .. 11 ) {
1837         last
1838         if ( ( caller($index) )[0] eq 'Catalyst'
1839             && ( caller($index) )[3] eq '(eval)' );
1840
1841         if ( ( caller($index) )[3] =~ /forward$/ ) {
1842             $callsub = ( caller($index) )[3];
1843             $action  = "-> $action";
1844             last;
1845         }
1846     }
1847
1848     my $uid = $action_name . $c->counter->{$action_name};
1849
1850     # is this a root-level call or a forwarded call?
1851     if ( $callsub =~ /forward$/ ) {
1852         my $parent = $c->stack->[-1];
1853
1854         # forward, locate the caller
1855         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1856             $c->stats->profile(
1857                 begin  => $action,
1858                 parent => "$parent" . $c->counter->{"$parent"},
1859                 uid    => $uid,
1860             );
1861         }
1862         else {
1863
1864             # forward with no caller may come from a plugin
1865             $c->stats->profile(
1866                 begin => $action,
1867                 uid   => $uid,
1868             );
1869         }
1870     }
1871     else {
1872
1873         # root-level call
1874         $c->stats->profile(
1875             begin => $action,
1876             uid   => $uid,
1877         );
1878     }
1879     return $action;
1880
1881 }
1882
1883 sub _stats_finish_execute {
1884     my ( $c, $info ) = @_;
1885     $c->stats->profile( end => $info );
1886 }
1887
1888 =head2 $c->finalize
1889
1890 Finalizes the request.
1891
1892 =cut
1893
1894 sub finalize {
1895     my $c = shift;
1896
1897     for my $error ( @{ $c->error } ) {
1898         $c->log->error($error);
1899     }
1900
1901     # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
1902     # stuff like cometd and websockets
1903     
1904     if($c->request->_has_io_fh) {
1905       $c->log_response;
1906       return;
1907     }
1908
1909     # Allow engine to handle finalize flow (for POE)
1910     my $engine = $c->engine;
1911     if ( my $code = $engine->can('finalize') ) {
1912         $engine->$code($c);
1913     }
1914     else {
1915
1916         $c->finalize_uploads;
1917
1918         # Error
1919         if ( $#{ $c->error } >= 0 ) {
1920             $c->finalize_error;
1921         }
1922
1923         $c->finalize_encoding;
1924         $c->finalize_headers unless $c->response->finalized_headers;
1925         $c->finalize_body;
1926     }
1927
1928     $c->log_response;
1929
1930     if ($c->use_stats) {
1931         my $elapsed = $c->stats->elapsed;
1932         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1933         $c->log->info(
1934             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1935     }
1936
1937     return $c->response->status;
1938 }
1939
1940 =head2 $c->finalize_body
1941
1942 Finalizes body.
1943
1944 =cut
1945
1946 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1947
1948 =head2 $c->finalize_cookies
1949
1950 Finalizes cookies.
1951
1952 =cut
1953
1954 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1955
1956 =head2 $c->finalize_error
1957
1958 Finalizes error.  If there is only one error in L</error> and it is an object that
1959 does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
1960 up the ladder.  Otherwise we return the debugging error page (in debug mode) or we
1961 return the default error page (production mode).
1962
1963 =cut
1964
1965 sub finalize_error {
1966     my $c = shift;
1967     if($#{$c->error} > 0) {
1968         $c->engine->finalize_error( $c, @_ );
1969     } else {
1970         my ($error) = @{$c->error};
1971         if(
1972           blessed $error &&
1973           ($error->can('as_psgi') || $error->can('code'))
1974         ) {
1975             # In the case where the error 'knows what it wants', becauses its PSGI
1976             # aware, just rethow and let middleware catch it
1977             $error->can('rethrow') ? $error->rethrow : croak $error;
1978         } else {
1979             $c->engine->finalize_error( $c, @_ )
1980         }
1981     }
1982 }
1983
1984 =head2 $c->finalize_headers
1985
1986 Finalizes headers.
1987
1988 =cut
1989
1990 sub finalize_headers {
1991     my $c = shift;
1992
1993     my $response = $c->response; #accessor calls can add up?
1994
1995     # Check if we already finalized headers
1996     return if $response->finalized_headers;
1997
1998     # Handle redirects
1999     if ( my $location = $response->redirect ) {
2000         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
2001         $response->header( Location => $location );
2002     }
2003
2004     # Remove incorrectly added body and content related meta data when returning
2005     # an information response, or a response the is required to not include a body
2006
2007     $c->finalize_cookies;
2008
2009     $c->response->finalize_headers();
2010
2011     # Done
2012     $response->finalized_headers(1);
2013 }
2014
2015 =head2 $c->finalize_encoding
2016
2017 Make sure your headers and body are encoded properly IF you set an encoding.
2018 See L</ENCODING>.
2019
2020 =cut
2021
2022 sub finalize_encoding {
2023     my $c = shift;
2024
2025     my $body = $c->response->body;
2026
2027     return unless defined($body);
2028
2029     my $enc = $c->encoding;
2030
2031     return unless $enc;
2032
2033     my ($ct, $ct_enc) = $c->response->content_type;
2034
2035     # Only touch 'text-like' contents
2036     return unless $c->response->content_type =~ /^text|xml$|javascript$/;
2037
2038     if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
2039         if (uc($1) ne uc($enc->mime_name)) {
2040             $c->log->debug("Unicode::Encoding is set to encode in '" .
2041                            $enc->mime_name .
2042                            "', content type is '$1', not encoding ");
2043             return;
2044         }
2045     } else {
2046         $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
2047     }
2048
2049     # Oh my, I wonder what filehandle responses and streams do... - jnap.
2050     # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
2051     $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) )
2052         if ref(\$body) eq 'SCALAR';
2053 }
2054
2055 =head2 $c->finalize_output
2056
2057 An alias for finalize_body.
2058
2059 =head2 $c->finalize_read
2060
2061 Finalizes the input after reading is complete.
2062
2063 =cut
2064
2065 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2066
2067 =head2 $c->finalize_uploads
2068
2069 Finalizes uploads. Cleans up any temporary files.
2070
2071 =cut
2072
2073 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2074
2075 =head2 $c->get_action( $action, $namespace )
2076
2077 Gets an action in a given namespace.
2078
2079 =cut
2080
2081 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
2082
2083 =head2 $c->get_actions( $action, $namespace )
2084
2085 Gets all actions of a given name in a namespace and all parent
2086 namespaces.
2087
2088 =cut
2089
2090 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2091
2092 =head2 $app->handle_request( @arguments )
2093
2094 Called to handle each HTTP request.
2095
2096 =cut
2097
2098 sub handle_request {
2099     my ( $class, @arguments ) = @_;
2100
2101     # Always expect worst case!
2102     my $status = -1;
2103     try {
2104         if ($class->debug) {
2105             my $secs = time - $START || 1;
2106             my $av = sprintf '%.3f', $COUNT / $secs;
2107             my $time = localtime time;
2108             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
2109         }
2110
2111         my $c = $class->prepare(@arguments);
2112         $c->dispatch;
2113         $status = $c->finalize;
2114     } catch {
2115         #rethow if this can be handled by middleware
2116         if(blessed $_ && ($_->can('as_psgi') || $_->can('code'))) {
2117             $_->can('rethrow') ? $_->rethrow : croak $_;
2118         }
2119         chomp(my $error = $_);
2120         $class->log->error(qq/Caught exception in engine "$error"/);
2121     };
2122
2123     $COUNT++;
2124
2125     if(my $coderef = $class->log->can('_flush')){
2126         $class->log->$coderef();
2127     }
2128     return $status;
2129 }
2130
2131 =head2 $class->prepare( @arguments )
2132
2133 Creates a Catalyst context from an engine-specific request (Apache, CGI,
2134 etc.).
2135
2136 =cut
2137
2138 has _uploadtmp => (
2139     is => 'ro',
2140     predicate => '_has_uploadtmp',
2141 );
2142
2143 sub prepare {
2144     my ( $class, @arguments ) = @_;
2145
2146     # XXX
2147     # After the app/ctxt split, this should become an attribute based on something passed
2148     # into the application.
2149     $class->context_class( ref $class || $class ) unless $class->context_class;
2150
2151     my $uploadtmp = $class->config->{uploadtmp};
2152     my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
2153
2154     $c->response->_context($c);
2155
2156     #surely this is not the most efficient way to do things...
2157     $c->stats($class->stats_class->new)->enable($c->use_stats);
2158     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
2159         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
2160     }
2161
2162     try {
2163         # Allow engine to direct the prepare flow (for POE)
2164         if ( my $prepare = $c->engine->can('prepare') ) {
2165             $c->engine->$prepare( $c, @arguments );
2166         }
2167         else {
2168             $c->prepare_request(@arguments);
2169             $c->prepare_connection;
2170             $c->prepare_query_parameters;
2171             $c->prepare_headers; # Just hooks, no longer needed - they just
2172             $c->prepare_cookies; # cause the lazy attribute on req to build
2173             $c->prepare_path;
2174
2175             # Prepare the body for reading, either by prepare_body
2176             # or the user, if they are using $c->read
2177             $c->prepare_read;
2178
2179             # Parse the body unless the user wants it on-demand
2180             unless ( ref($c)->config->{parse_on_demand} ) {
2181                 $c->prepare_body;
2182             }
2183         }
2184         $c->prepare_action;
2185     }
2186     # VERY ugly and probably shouldn't rely on ->finalize actually working
2187     catch {
2188         # failed prepare is always due to an invalid request, right?
2189         $c->response->status(400);
2190         $c->response->content_type('text/plain');
2191         $c->response->body('Bad Request');
2192         # Note we call finalize and then die here, which escapes
2193         # finalize being called in the enclosing block..
2194         # It in fact couldn't be called, as we don't return $c..
2195         # This is a mess - but I'm unsure you can fix this without
2196         # breaking compat for people doing crazy things (we should set
2197         # the 400 and just return the ctx here IMO, letting finalize get called
2198         # above...
2199         $c->finalize;
2200         die $_;
2201     };
2202
2203     $c->log_request;
2204
2205     return $c;
2206 }
2207
2208 =head2 $c->prepare_action
2209
2210 Prepares action. See L<Catalyst::Dispatcher>.
2211
2212 =cut
2213
2214 sub prepare_action {
2215     my $c = shift;
2216     my $ret = $c->dispatcher->prepare_action( $c, @_);
2217
2218     if($c->encoding) {
2219         foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2220           $_ = $c->_handle_param_unicode_decoding($_);
2221         }
2222     }
2223
2224     return $ret;
2225 }
2226
2227
2228 =head2 $c->prepare_body
2229
2230 Prepares message body.
2231
2232 =cut
2233
2234 sub prepare_body {
2235     my $c = shift;
2236
2237     return if $c->request->_has_body;
2238
2239     # Initialize on-demand data
2240     $c->engine->prepare_body( $c, @_ );
2241     $c->prepare_parameters;
2242     $c->prepare_uploads;
2243 }
2244
2245 =head2 $c->prepare_body_chunk( $chunk )
2246
2247 Prepares a chunk of data before sending it to L<HTTP::Body>.
2248
2249 See L<Catalyst::Engine>.
2250
2251 =cut
2252
2253 sub prepare_body_chunk {
2254     my $c = shift;
2255     $c->engine->prepare_body_chunk( $c, @_ );
2256 }
2257
2258 =head2 $c->prepare_body_parameters
2259
2260 Prepares body parameters.
2261
2262 =cut
2263
2264 sub prepare_body_parameters {
2265     my $c = shift;
2266     $c->engine->prepare_body_parameters( $c, @_ );
2267 }
2268
2269 =head2 $c->prepare_connection
2270
2271 Prepares connection.
2272
2273 =cut
2274
2275 sub prepare_connection {
2276     my $c = shift;
2277     $c->request->prepare_connection($c);
2278 }
2279
2280 =head2 $c->prepare_cookies
2281
2282 Prepares cookies by ensuring that the attribute on the request
2283 object has been built.
2284
2285 =cut
2286
2287 sub prepare_cookies { my $c = shift; $c->request->cookies }
2288
2289 =head2 $c->prepare_headers
2290
2291 Prepares request headers by ensuring that the attribute on the request
2292 object has been built.
2293
2294 =cut
2295
2296 sub prepare_headers { my $c = shift; $c->request->headers }
2297
2298 =head2 $c->prepare_parameters
2299
2300 Prepares parameters.
2301
2302 =cut
2303
2304 sub prepare_parameters {
2305     my $c = shift;
2306     $c->prepare_body_parameters;
2307     $c->engine->prepare_parameters( $c, @_ );
2308 }
2309
2310 =head2 $c->prepare_path
2311
2312 Prepares path and base.
2313
2314 =cut
2315
2316 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2317
2318 =head2 $c->prepare_query_parameters
2319
2320 Prepares query parameters.
2321
2322 =cut
2323
2324 sub prepare_query_parameters {
2325     my $c = shift;
2326
2327     $c->engine->prepare_query_parameters( $c, @_ );
2328 }
2329
2330 =head2 $c->log_request
2331
2332 Writes information about the request to the debug logs.  This includes:
2333
2334 =over 4
2335
2336 =item * Request method, path, and remote IP address
2337
2338 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2339
2340 =item * Request parameters
2341
2342 =item * File uploads
2343
2344 =back
2345
2346 =cut
2347
2348 sub log_request {
2349     my $c = shift;
2350
2351     return unless $c->debug;
2352
2353     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2354     my $request = $dump->[1];
2355
2356     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2357     $method ||= '';
2358     $path = '/' unless length $path;
2359     $address ||= '';
2360     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2361
2362     $c->log_request_headers($request->headers);
2363
2364     if ( my $keywords = $request->query_keywords ) {
2365         $c->log->debug("Query keywords are: $keywords");
2366     }
2367
2368     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2369
2370     $c->log_request_uploads($request);
2371 }
2372
2373 =head2 $c->log_response
2374
2375 Writes information about the response to the debug logs by calling
2376 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2377
2378 =cut
2379
2380 sub log_response {
2381     my $c = shift;
2382
2383     return unless $c->debug;
2384
2385     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2386     my $response = $dump->[1];
2387
2388     $c->log_response_status_line($response);
2389     $c->log_response_headers($response->headers);
2390 }
2391
2392 =head2 $c->log_response_status_line($response)
2393
2394 Writes one line of information about the response to the debug logs.  This includes:
2395
2396 =over 4
2397
2398 =item * Response status code
2399
2400 =item * Content-Type header (if present)
2401
2402 =item * Content-Length header (if present)
2403
2404 =back
2405
2406 =cut
2407
2408 sub log_response_status_line {
2409     my ($c, $response) = @_;
2410
2411     $c->log->debug(
2412         sprintf(
2413             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2414             $response->status                            || 'unknown',
2415             $response->headers->header('Content-Type')   || 'unknown',
2416             $response->headers->header('Content-Length') || 'unknown'
2417         )
2418     );
2419 }
2420
2421 =head2 $c->log_response_headers($headers);
2422
2423 Hook method which can be wrapped by plugins to log the response headers.
2424 No-op in the default implementation.
2425
2426 =cut
2427
2428 sub log_response_headers {}
2429
2430 =head2 $c->log_request_parameters( query => {}, body => {} )
2431
2432 Logs request parameters to debug logs
2433
2434 =cut
2435
2436 sub log_request_parameters {
2437     my $c          = shift;
2438     my %all_params = @_;
2439
2440     return unless $c->debug;
2441
2442     my $column_width = Catalyst::Utils::term_width() - 44;
2443     foreach my $type (qw(query body)) {
2444         my $params = $all_params{$type};
2445         next if ! keys %$params;
2446         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2447         for my $key ( sort keys %$params ) {
2448             my $param = $params->{$key};
2449             my $value = defined($param) ? $param : '';
2450             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2451         }
2452         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2453     }
2454 }
2455
2456 =head2 $c->log_request_uploads
2457
2458 Logs file uploads included in the request to the debug logs.
2459 The parameter name, filename, file type, and file size are all included in
2460 the debug logs.
2461
2462 =cut
2463
2464 sub log_request_uploads {
2465     my $c = shift;
2466     my $request = shift;
2467     return unless $c->debug;
2468     my $uploads = $request->uploads;
2469     if ( keys %$uploads ) {
2470         my $t = Text::SimpleTable->new(
2471             [ 12, 'Parameter' ],
2472             [ 26, 'Filename' ],
2473             [ 18, 'Type' ],
2474             [ 9,  'Size' ]
2475         );
2476         for my $key ( sort keys %$uploads ) {
2477             my $upload = $uploads->{$key};
2478             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2479                 $t->row( $key, $u->filename, $u->type, $u->size );
2480             }
2481         }
2482         $c->log->debug( "File Uploads are:\n" . $t->draw );
2483     }
2484 }
2485
2486 =head2 $c->log_request_headers($headers);
2487
2488 Hook method which can be wrapped by plugins to log the request headers.
2489 No-op in the default implementation.
2490
2491 =cut
2492
2493 sub log_request_headers {}
2494
2495 =head2 $c->log_headers($type => $headers)
2496
2497 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2498
2499 =cut
2500
2501 sub log_headers {
2502     my $c       = shift;
2503     my $type    = shift;
2504     my $headers = shift;    # an HTTP::Headers instance
2505
2506     return unless $c->debug;
2507
2508     my $column_width = Catalyst::Utils::term_width() - 28;
2509     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2510     $headers->scan(
2511         sub {
2512             my ( $name, $value ) = @_;
2513             $t->row( $name, $value );
2514         }
2515     );
2516     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2517 }
2518
2519
2520 =head2 $c->prepare_read
2521
2522 Prepares the input for reading.
2523
2524 =cut
2525
2526 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2527
2528 =head2 $c->prepare_request
2529
2530 Prepares the engine request.
2531
2532 =cut
2533
2534 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2535
2536 =head2 $c->prepare_uploads
2537
2538 Prepares uploads.
2539
2540 =cut
2541
2542 sub prepare_uploads {
2543     my $c = shift;
2544     $c->engine->prepare_uploads( $c, @_ );
2545
2546     my $enc = $c->encoding;
2547     return unless $enc;
2548
2549     # Uggg we hook prepare uploads to do the encoding crap on post and query
2550     # parameters!  Sorry -jnap
2551     for my $key (qw/ parameters query_parameters body_parameters /) {
2552         for my $value ( values %{ $c->request->{$key} } ) {
2553             # N.B. Check if already a character string and if so do not try to double decode.
2554             #      http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html
2555             #      this avoids exception if we have already decoded content, and is _not_ the
2556             #      same as not encoding on output which is bad news (as it does the wrong thing
2557             #      for latin1 chars for example)..
2558             $value = $c->_handle_unicode_decoding($value);
2559         }
2560     }
2561     for my $value ( values %{ $c->request->uploads } ) {
2562         # skip if it fails for uploads, as we don't usually want uploads touched
2563         # in any way
2564         for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) {
2565             $inner_value->{filename} = try {
2566                 $enc->decode( $inner_value->{filename}, $c->_encode_check )
2567             } catch {
2568                 $c->handle_unicode_encoding_exception({
2569                     param_value => $inner_value->{filename},
2570                     error_msg => $_,
2571                     encoding_step => 'uploads',
2572                 });
2573             };
2574         }
2575     }
2576 }
2577
2578 =head2 $c->prepare_write
2579
2580 Prepares the output for writing.
2581
2582 =cut
2583
2584 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2585
2586 =head2 $c->request_class
2587
2588 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2589
2590 =head2 $c->response_class
2591
2592 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2593
2594 =head2 $c->read( [$maxlength] )
2595
2596 Reads a chunk of data from the request body. This method is designed to
2597 be used in a while loop, reading C<$maxlength> bytes on every call.
2598 C<$maxlength> defaults to the size of the request if not specified.
2599
2600 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2601 directly.
2602
2603 Warning: If you use read(), Catalyst will not process the body,
2604 so you will not be able to access POST parameters or file uploads via
2605 $c->request.  You must handle all body parsing yourself.
2606
2607 =cut
2608
2609 sub read { my $c = shift; return $c->request->read( @_ ) }
2610
2611 =head2 $c->run
2612
2613 Starts the engine.
2614
2615 =cut
2616
2617 sub run {
2618   my $app = shift;
2619   $app->_make_immutable_if_needed;
2620   $app->engine_loader->needs_psgi_engine_compat_hack ?
2621     $app->engine->run($app, @_) :
2622       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2623 }
2624
2625 sub _make_immutable_if_needed {
2626     my $class = shift;
2627     my $meta = find_meta($class);
2628     my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2629     if (
2630         $meta->is_immutable
2631         && ! { $meta->immutable_options }->{replace_constructor}
2632         && $isa_ca
2633     ) {
2634         warn("You made your application class ($class) immutable, "
2635             . "but did not inline the\nconstructor. "
2636             . "This will break catalyst, as your app \@ISA "
2637             . "Class::Accessor(::Fast)?\nPlease pass "
2638             . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2639     }
2640     unless ($meta->is_immutable) {
2641         # XXX - FIXME warning here as you should make your app immutable yourself.
2642         $meta->make_immutable(
2643             replace_constructor => 1,
2644         );
2645     }
2646 }
2647
2648 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2649
2650 Sets an action in a given namespace.
2651
2652 =cut
2653
2654 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2655
2656 =head2 $c->setup_actions($component)
2657
2658 Sets up actions for a component.
2659
2660 =cut
2661
2662 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2663
2664 =head2 $c->setup_components
2665
2666 This method is called internally to set up the application's components.
2667
2668 It finds modules by calling the L<locate_components> method, expands them to
2669 package names with the L<expand_component_module> method, and then installs
2670 each component into the application.
2671
2672 The C<setup_components> config option is passed to both of the above methods.
2673
2674 Installation of each component is performed by the L<setup_component> method,
2675 below.
2676
2677 =cut
2678
2679 sub setup_components {
2680     my $class = shift;
2681
2682     my $config  = $class->config->{ setup_components };
2683
2684     my @comps = $class->locate_components($config);
2685     my %comps = map { $_ => 1 } @comps;
2686
2687     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2688     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2689         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2690     ) if $deprecatedcatalyst_component_names;
2691
2692     for my $component ( @comps ) {
2693
2694         # We pass ignore_loaded here so that overlay files for (e.g.)
2695         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2696         # we know M::P::O found a file on disk so this is safe
2697
2698         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2699     }
2700
2701     for my $component (@comps) {
2702         my $instance = $class->components->{ $component } = $class->setup_component($component);
2703         my @expanded_components = $instance->can('expand_modules')
2704             ? $instance->expand_modules( $component, $config )
2705             : $class->expand_component_module( $component, $config );
2706         for my $component (@expanded_components) {
2707             next if $comps{$component};
2708             $class->components->{ $component } = $class->setup_component($component);
2709         }
2710     }
2711 }
2712
2713 =head2 $c->locate_components( $setup_component_config )
2714
2715 This method is meant to provide a list of component modules that should be
2716 setup for the application.  By default, it will use L<Module::Pluggable>.
2717
2718 Specify a C<setup_components> config option to pass additional options directly
2719 to L<Module::Pluggable>. To add additional search paths, specify a key named
2720 C<search_extra> as an array reference. Items in the array beginning with C<::>
2721 will have the application class name prepended to them.
2722
2723 =cut
2724
2725 sub locate_components {
2726     my $class  = shift;
2727     my $config = shift;
2728
2729     my @paths   = qw( ::M ::Model ::V ::View ::C ::Controller );
2730     my $extra   = delete $config->{ search_extra } || [];
2731
2732     unshift @paths, @$extra;
2733
2734     my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new(
2735       search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ],
2736       %$config
2737     )->plugins } @paths;
2738
2739     return @comps;
2740 }
2741
2742 =head2 $c->expand_component_module( $component, $setup_component_config )
2743
2744 Components found by C<locate_components> will be passed to this method, which
2745 is expected to return a list of component (package) names to be set up.
2746
2747 =cut
2748
2749 sub expand_component_module {
2750     my ($class, $module) = @_;
2751     return Devel::InnerPackage::list_packages( $module );
2752 }
2753
2754 =head2 $c->setup_component
2755
2756 =cut
2757
2758 sub setup_component {
2759     my( $class, $component ) = @_;
2760
2761     unless ( $component->can( 'COMPONENT' ) ) {
2762         return $component;
2763     }
2764
2765     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2766     my $config = $class->config->{ $suffix } || {};
2767     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2768     # methods also pass it. local to avoid pointlessly shitting in config
2769     # for the debug screen, as $component is already the key name.
2770     local $config->{catalyst_component_name} = $component;
2771
2772     my $instance = eval { $component->COMPONENT( $class, $config ); };
2773
2774     if ( my $error = $@ ) {
2775         chomp $error;
2776         Catalyst::Exception->throw(
2777             message => qq/Couldn't instantiate component "$component", "$error"/
2778         );
2779     }
2780
2781     unless (blessed $instance) {
2782         my $metaclass = Moose::Util::find_meta($component);
2783         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2784         my $component_method_from = $method_meta->associated_metaclass->name;
2785         my $value = defined($instance) ? $instance : 'undef';
2786         Catalyst::Exception->throw(
2787             message =>
2788             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2789         );
2790     }
2791     return $instance;
2792 }
2793
2794 =head2 $c->setup_dispatcher
2795
2796 Sets up dispatcher.
2797
2798 =cut
2799
2800 sub setup_dispatcher {
2801     my ( $class, $dispatcher ) = @_;
2802
2803     if ($dispatcher) {
2804         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2805     }
2806
2807     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2808         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2809     }
2810
2811     unless ($dispatcher) {
2812         $dispatcher = $class->dispatcher_class;
2813     }
2814
2815     load_class($dispatcher);
2816
2817     # dispatcher instance
2818     $class->dispatcher( $dispatcher->new );
2819 }
2820
2821 =head2 $c->setup_engine
2822
2823 Sets up engine.
2824
2825 =cut
2826
2827 sub engine_class {
2828     my ($class, $requested_engine) = @_;
2829
2830     if (!$class->engine_loader || $requested_engine) {
2831         $class->engine_loader(
2832             Catalyst::EngineLoader->new({
2833                 application_name => $class,
2834                 (defined $requested_engine
2835                      ? (catalyst_engine_class => $requested_engine) : ()),
2836             }),
2837         );
2838     }
2839
2840     $class->engine_loader->catalyst_engine_class;
2841 }
2842
2843 sub setup_engine {
2844     my ($class, $requested_engine) = @_;
2845
2846     my $engine = do {
2847         my $loader = $class->engine_loader;
2848
2849         if (!$loader || $requested_engine) {
2850             $loader = Catalyst::EngineLoader->new({
2851                 application_name => $class,
2852                 (defined $requested_engine
2853                      ? (requested_engine => $requested_engine) : ()),
2854             }),
2855
2856             $class->engine_loader($loader);
2857         }
2858
2859         $loader->catalyst_engine_class;
2860     };
2861
2862     # Don't really setup_engine -- see _setup_psgi_app for explanation.
2863     return if $class->loading_psgi_file;
2864
2865     load_class($engine);
2866
2867     if ($ENV{MOD_PERL}) {
2868         my $apache = $class->engine_loader->auto;
2869
2870         my $meta = find_meta($class);
2871         my $was_immutable = $meta->is_immutable;
2872         my %immutable_options = $meta->immutable_options;
2873         $meta->make_mutable if $was_immutable;
2874
2875         $meta->add_method(handler => sub {
2876             my $r = shift;
2877             my $psgi_app = $class->_finalized_psgi_app;
2878             $apache->call_app($r, $psgi_app);
2879         });
2880
2881         $meta->make_immutable(%immutable_options) if $was_immutable;
2882     }
2883
2884     $class->engine( $engine->new );
2885
2886     return;
2887 }
2888
2889 ## This exists just to supply a prebuild psgi app for mod_perl and for the 
2890 ## build in server support (back compat support for pre psgi port behavior).
2891 ## This is so that we don't build a new psgi app for each request when using
2892 ## the mod_perl handler or the built in servers (http and fcgi, etc).
2893
2894 sub _finalized_psgi_app {
2895     my ($app) = @_;
2896
2897     unless ($app->_psgi_app) {
2898         my $psgi_app = $app->_setup_psgi_app;
2899         $app->_psgi_app($psgi_app);
2900     }
2901
2902     return $app->_psgi_app;
2903 }
2904
2905 ## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the
2906 ## home directory and load that and return it (just assume it is doing the 
2907 ## right thing :) ).  If that does not exist, call $app->psgi_app, wrap that
2908 ## in default_middleware and return it ( this is for backward compatibility
2909 ## with pre psgi port behavior ).
2910
2911 sub _setup_psgi_app {
2912     my ($app) = @_;
2913
2914     for my $home (Path::Class::Dir->new($app->config->{home})) {
2915         my $psgi_file = $home->file(
2916             Catalyst::Utils::appprefix($app) . '.psgi',
2917         );
2918
2919         next unless -e $psgi_file;
2920
2921         # If $psgi_file calls ->setup_engine, it's doing so to load
2922         # Catalyst::Engine::PSGI. But if it does that, we're only going to
2923         # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
2924         # anyway. So set a flag (ick) that tells setup_engine not to populate
2925         # $c->engine or do any other things we might regret.
2926
2927         $app->loading_psgi_file(1);
2928         my $psgi_app = Plack::Util::load_psgi($psgi_file);
2929         $app->loading_psgi_file(0);
2930
2931         return $psgi_app
2932             unless $app->engine_loader->needs_psgi_engine_compat_hack;
2933
2934         warn <<"EOW";
2935 Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
2936
2937 Its content has been ignored. Please consult the Catalyst::Upgrading
2938 documentation on how to upgrade from Catalyst::Engine::PSGI.
2939 EOW
2940     }
2941
2942     return $app->apply_default_middlewares($app->psgi_app);
2943 }
2944
2945 =head2 $c->apply_default_middlewares
2946
2947 Adds the following L<Plack> middlewares to your application, since they are
2948 useful and commonly needed:
2949
2950 L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
2951 of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
2952 or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
2953 (if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
2954 applied since this middleware is smart enough to conditionally apply itself).
2955
2956 Additionally if we detect we are using Nginx, we add a bit of custom middleware
2957 to solve some problems with the way that server handles $ENV{PATH_INFO} and
2958 $ENV{SCRIPT_NAME}
2959
2960 =cut
2961
2962
2963 sub apply_default_middlewares {
2964     my ($app, $psgi_app) = @_;
2965
2966     $psgi_app = Plack::Middleware::Conditional->wrap(
2967         $psgi_app,
2968         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2969         condition => sub {
2970             my ($env) = @_;
2971             return if $app->config->{ignore_frontend_proxy};
2972             return $env->{REMOTE_ADDR} eq '127.0.0.1'
2973                 || $app->config->{using_frontend_proxy};
2974         },
2975     );
2976
2977     # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
2978     # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
2979     $psgi_app = Plack::Middleware::Conditional->wrap(
2980         $psgi_app,
2981         builder   => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) },
2982         condition => sub {
2983             my ($env) = @_;
2984             return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!;
2985             return unless $1 < 4.23;
2986             1;
2987         },
2988     );
2989
2990     # we're applying this unconditionally as the middleware itself already makes
2991     # sure it doesn't fuck things up if it's not running under one of the right
2992     # IIS versions
2993     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
2994
2995     # And another IIS issue, this time with IIS7.
2996     $psgi_app = Plack::Middleware::Conditional->wrap(
2997         $psgi_app,
2998         builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
2999         condition => sub {
3000             my ($env) = @_;
3001             return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
3002         },
3003     );
3004
3005     return $psgi_app;
3006 }
3007
3008 =head2 App->psgi_app
3009
3010 =head2 App->to_app
3011
3012 Returns a PSGI application code reference for the catalyst application
3013 C<$c>. This is the bare application without any middlewares
3014 applied. C<${myapp}.psgi> is not taken into account.
3015
3016 This is what you want to be using to retrieve the PSGI application code
3017 reference of your Catalyst application for use in F<.psgi> files.
3018
3019 =cut
3020
3021 *to_app = \&psgi_app;
3022
3023 sub psgi_app {
3024     my ($app) = @_;
3025     my $psgi = $app->engine->build_psgi_app($app);
3026     return $app->Catalyst::Utils::apply_registered_middleware($psgi);
3027 }
3028
3029 =head2 $c->setup_home
3030
3031 Sets up the home directory.
3032
3033 =cut
3034
3035 sub setup_home {
3036     my ( $class, $home ) = @_;
3037
3038     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
3039         $home = $env;
3040     }
3041
3042     $home ||= Catalyst::Utils::home($class);
3043
3044     if ($home) {
3045         #I remember recently being scolded for assigning config values like this
3046         $class->config->{home} ||= $home;
3047         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
3048     }
3049 }
3050
3051 =head2 $c->setup_encoding
3052
3053 Sets up the input/output encoding.  See L<ENCODING>
3054
3055 =cut
3056
3057 sub setup_encoding {
3058     my $c = shift;
3059     my $enc = delete $c->config->{encoding};
3060     $c->encoding( $enc ) if defined $enc;
3061 }
3062
3063 =head2 handle_unicode_encoding_exception
3064
3065 Hook to let you customize how encoding errors are handled.  By default
3066 we just throw an exception.  Receives a hashref of debug information.
3067 Example:
3068
3069     $c->handle_unicode_encoding_exception({
3070         param_value => $value,
3071         error_msg => $_,
3072             encoding_step => 'params',
3073         });
3074
3075 =cut
3076
3077 sub handle_unicode_encoding_exception {
3078     my ( $self, $exception_ctx ) = @_;
3079     die $exception_ctx->{error_msg};
3080 }
3081
3082 # Some unicode helpers cargo culted from the old plugin.  These could likely
3083 # be neater.
3084
3085 sub _handle_unicode_decoding {
3086     my ( $self, $value ) = @_;
3087
3088     return unless defined $value;
3089
3090     ## I think this mess is to support the old nested
3091     if ( ref $value eq 'ARRAY' ) {
3092         foreach ( @$value ) {
3093             $_ = $self->_handle_unicode_decoding($_);
3094         }
3095         return $value;
3096     }
3097     elsif ( ref $value eq 'HASH' ) {
3098         foreach ( values %$value ) {
3099             $_ = $self->_handle_unicode_decoding($_);
3100         }
3101         return $value;
3102     }
3103     else {
3104         return $self->_handle_param_unicode_decoding($value);
3105     }
3106 }
3107
3108 sub _handle_param_unicode_decoding {
3109     my ( $self, $value ) = @_;
3110     return unless defined $value; # not in love with just ignoring undefs - jnap
3111
3112     my $enc = $self->encoding;
3113     return try {
3114         Encode::is_utf8( $value ) ?
3115             $value
3116         : $enc->decode( $value, $self->_encode_check );
3117     }
3118     catch {
3119         $self->handle_unicode_encoding_exception({
3120             param_value => $value,
3121             error_msg => $_,
3122             encoding_step => 'params',
3123         });
3124     };
3125 }
3126
3127 =head2 $c->setup_log
3128
3129 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
3130 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
3131 log to.
3132
3133 This method also installs a C<debug> method that returns a true value into the
3134 catalyst subclass if the "debug" level is passed in the comma-delimited list,
3135 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
3136
3137 Note that if the log has already been setup, by either a previous call to
3138 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
3139 that this method won't actually set up the log object.
3140
3141 =cut
3142
3143 sub setup_log {
3144     my ( $class, $levels ) = @_;
3145
3146     $levels ||= '';
3147     $levels =~ s/^\s+//;
3148     $levels =~ s/\s+$//;
3149     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
3150
3151     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
3152     if ( defined $env_debug ) {
3153         $levels{debug} = 1 if $env_debug; # Ugly!
3154         delete($levels{debug}) unless $env_debug;
3155     }
3156
3157     unless ( $class->log ) {
3158         $class->log( Catalyst::Log->new(keys %levels) );
3159     }
3160
3161     if ( $levels{debug} ) {
3162         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
3163         $class->log->debug('Debug messages enabled');
3164     }
3165 }
3166
3167 =head2 $c->setup_plugins
3168
3169 Sets up plugins.
3170
3171 =cut
3172
3173 =head2 $c->setup_stats
3174
3175 Sets up timing statistics class.
3176
3177 =cut
3178
3179 sub setup_stats {
3180     my ( $class, $stats ) = @_;
3181
3182     Catalyst::Utils::ensure_class_loaded($class->stats_class);
3183
3184     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
3185     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
3186         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
3187         $class->log->debug('Statistics enabled');
3188     }
3189 }
3190
3191
3192 =head2 $c->registered_plugins
3193
3194 Returns a sorted list of the plugins which have either been stated in the
3195 import list.
3196
3197 If passed a given plugin name, it will report a boolean value indicating
3198 whether or not that plugin is loaded.  A fully qualified name is required if
3199 the plugin name does not begin with C<Catalyst::Plugin::>.
3200
3201  if ($c->registered_plugins('Some::Plugin')) {
3202      ...
3203  }
3204
3205 =cut
3206
3207 {
3208
3209     sub registered_plugins {
3210         my $proto = shift;
3211         return sort keys %{ $proto->_plugins } unless @_;
3212         my $plugin = shift;
3213         return 1 if exists $proto->_plugins->{$plugin};
3214         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
3215     }
3216
3217     sub _register_plugin {
3218         my ( $proto, $plugin, $instant ) = @_;
3219         my $class = ref $proto || $proto;
3220
3221         load_class( $plugin );
3222         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
3223             if $plugin->isa( 'Catalyst::Component' );
3224         my $plugin_meta = Moose::Meta::Class->create($plugin);
3225         if (!$plugin_meta->has_method('new')
3226             && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
3227             $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
3228         }
3229         if (!$instant && !$proto->_plugins->{$plugin}) {
3230             my $meta = Class::MOP::get_metaclass_by_name($class);
3231             $meta->superclasses($plugin, $meta->superclasses);
3232         }
3233         $proto->_plugins->{$plugin} = 1;
3234         return $class;
3235     }
3236
3237     sub _default_plugins { return qw() }
3238
3239     sub setup_plugins {
3240         my ( $class, $plugins ) = @_;
3241
3242         $class->_plugins( {} ) unless $class->_plugins;
3243         $plugins = [ grep {
3244             m/Unicode::Encoding/ ? do {
3245                 $class->log->warn(
3246                     'Unicode::Encoding plugin is auto-applied,'
3247                     . ' please remove this from your appclass'
3248                     . ' and make sure to define "encoding" config'
3249                 );
3250                 unless (exists $class->config->{'encoding'}) {
3251                   $class->config->{'encoding'} = 'UTF-8';
3252                 }
3253                 () }
3254                 : $_
3255         } @$plugins ];
3256         push @$plugins, $class->_default_plugins;
3257         $plugins = Data::OptList::mkopt($plugins || []);
3258
3259         my @plugins = map {
3260             [ Catalyst::Utils::resolve_namespace(
3261                   $class . '::Plugin',
3262                   'Catalyst::Plugin', $_->[0]
3263               ),
3264               $_->[1],
3265             ]
3266          } @{ $plugins };
3267
3268         for my $plugin ( reverse @plugins ) {
3269             load_class($plugin->[0], $plugin->[1]);
3270             my $meta = find_meta($plugin->[0]);
3271             next if $meta && $meta->isa('Moose::Meta::Role');
3272
3273             $class->_register_plugin($plugin->[0]);
3274         }
3275
3276         my @roles =
3277             map  { $_->[0]->name, $_->[1] }
3278             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
3279             map  { [find_meta($_->[0]), $_->[1]] }
3280             @plugins;
3281
3282         Moose::Util::apply_all_roles(
3283             $class => @roles
3284         ) if @roles;
3285     }
3286 }    
3287
3288 =head2 registered_middlewares
3289
3290 Read only accessor that returns an array of all the middleware in the order
3291 that they were added (which is the REVERSE of the order they will be applied).
3292
3293 The values returned will be either instances of L<Plack::Middleware> or of a
3294 compatible interface, or a coderef, which is assumed to be inlined middleware
3295
3296 =head2 setup_middleware (?@middleware)
3297
3298 Read configuration information stored in configuration key C<psgi_middleware> or
3299 from passed @args.
3300
3301 See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
3302 to use it to enable L<Plack::Middleware>
3303
3304 This method is automatically called during 'setup' of your application, so
3305 you really don't need to invoke it.  However you may do so if you find the idea
3306 of loading middleware via configuration weird :).  For example:
3307
3308     package MyApp;
3309
3310     use Catalyst;
3311
3312     __PACKAGE__->setup_middleware('Head');
3313     __PACKAGE__->setup;
3314
3315 When we read middleware definitions from configuration, we reverse the list
3316 which sounds odd but is likely how you expect it to work if you have prior
3317 experience with L<Plack::Builder> or if you previously used the plugin
3318 L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
3319
3320 So basically your middleware handles an incoming request from the first
3321 registered middleware, down and handles the response from the last middleware
3322 up.
3323
3324 =cut
3325
3326 sub registered_middlewares {
3327     my $class = shift;
3328     if(my $middleware = $class->_psgi_middleware) {
3329         return (
3330           Catalyst::Middleware::Stash->new,
3331           Plack::Middleware::HTTPExceptions->new,
3332           Plack::Middleware::RemoveRedundantBody->new,
3333           Plack::Middleware::FixMissingBodyInRedirect->new,
3334           Plack::Middleware::ContentLength->new,
3335           Plack::Middleware::MethodOverride->new,
3336           Plack::Middleware::Head->new,
3337           @$middleware);
3338     } else {
3339         die "You cannot call ->registered_middlewares until middleware has been setup";
3340     }
3341 }
3342
3343 sub setup_middleware {
3344     my $class = shift;
3345     my @middleware_definitions = @_ ? 
3346       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
3347
3348     my @middleware = ();
3349     while(my $next = shift(@middleware_definitions)) {
3350         if(ref $next) {
3351             if(Scalar::Util::blessed $next && $next->can('wrap')) {
3352                 push @middleware, $next;
3353             } elsif(ref $next eq 'CODE') {
3354                 push @middleware, $next;
3355             } elsif(ref $next eq 'HASH') {
3356                 my $namespace = shift @middleware_definitions;
3357                 my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
3358                 push @middleware, $mw;
3359             } else {
3360               die "I can't handle middleware definition ${\ref $next}";
3361             }
3362         } else {
3363           my $mw = $class->Catalyst::Utils::build_middleware($next);
3364           push @middleware, $mw;
3365         }
3366     }
3367
3368     my @existing = @{$class->_psgi_middleware || []};
3369     $class->_psgi_middleware([@middleware,@existing,]);
3370 }
3371
3372 =head2 registered_data_handlers
3373
3374 A read only copy of registered Data Handlers returned as a Hash, where each key
3375 is a content type and each value is a subref that attempts to decode that content
3376 type.
3377
3378 =head2 setup_data_handlers (?@data_handler)
3379
3380 Read configuration information stored in configuration key C<data_handlers> or
3381 from passed @args.
3382
3383 See under L</CONFIGURATION> information regarding C<data_handlers>.
3384
3385 This method is automatically called during 'setup' of your application, so
3386 you really don't need to invoke it.
3387
3388 =head2 default_data_handlers
3389
3390 Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
3391 only two default data handlers, for 'application/json' and an alternative to
3392 'application/x-www-form-urlencoded' which supposed nested form parameters via
3393 L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
3394
3395 The 'application/json' data handler is used to parse incoming JSON into a Perl
3396 data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
3397 is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
3398 JSON decoder, and has the smallest dependency impact.
3399
3400 Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
3401 use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
3402 order to get the best performance.  You should add either to your dependency
3403 list (Makefile.PL, dist.ini, cpanfile, etc.)
3404
3405 =cut
3406
3407 sub registered_data_handlers {
3408     my $class = shift;
3409     if(my $data_handlers = $class->_data_handlers) {
3410         return %$data_handlers;
3411     } else {
3412         $class->setup_data_handlers;
3413         return $class->registered_data_handlers;
3414     }
3415 }
3416
3417 sub setup_data_handlers {
3418     my ($class, %data_handler_callbacks) = @_;
3419     %data_handler_callbacks = (
3420       %{$class->default_data_handlers},
3421       %{$class->config->{'data_handlers'}||+{}},
3422       %data_handler_callbacks);
3423
3424     $class->_data_handlers(\%data_handler_callbacks);
3425 }
3426
3427 sub default_data_handlers {
3428     my ($class) = @_;
3429     return +{
3430       'application/x-www-form-urlencoded' => sub {
3431           my ($fh, $req) = @_;
3432           my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
3433           Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
3434             ->can('build_cgi_struct')->($params);
3435       },
3436       'application/json' => sub {
3437           Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
3438             ->can('decode_json')->(do { local $/; $_->getline });
3439       },
3440     };
3441 }
3442
3443 =head2 $c->stack
3444
3445 Returns an arrayref of the internal execution stack (actions that are
3446 currently executing).
3447
3448 =head2 $c->stats
3449
3450 Returns the current timing statistics object. By default Catalyst uses
3451 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
3452 L<< stats_class|/"$c->stats_class" >>.
3453
3454 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
3455 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
3456 profile explicitly, although MyApp.pm still won't profile nor output anything
3457 by itself.
3458
3459 =head2 $c->stats_class
3460
3461 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
3462
3463 =head2 $c->use_stats
3464
3465 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
3466
3467 Note that this is a static method, not an accessor and should be overridden
3468 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
3469
3470 =cut
3471
3472 sub use_stats { 0 }
3473
3474
3475 =head2 $c->write( $data )
3476
3477 Writes $data to the output stream. When using this method directly, you
3478 will need to manually set the C<Content-Length> header to the length of
3479 your output data, if known.
3480
3481 =cut
3482
3483 sub write {
3484     my $c = shift;
3485
3486     # Finalize headers if someone manually writes output (for compat)
3487     $c->finalize_headers;
3488
3489     return $c->response->write( @_ );
3490 }
3491
3492 =head2 version
3493
3494 Returns the Catalyst version number. Mostly useful for "powered by"
3495 messages in template systems.
3496
3497 =cut
3498
3499 sub version { return $Catalyst::VERSION }
3500
3501 =head1 CONFIGURATION
3502
3503 There are a number of 'base' config variables which can be set:
3504
3505 =over
3506
3507 =item *
3508
3509 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
3510
3511 =item *
3512
3513 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
3514
3515 =item *
3516
3517 C<disable_component_resolution_regex_fallback> - Turns
3518 off the deprecated component resolution functionality so
3519 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
3520 are called then regex search will not be attempted on string values and
3521 instead C<undef> will be returned.
3522
3523 =item *
3524
3525 C<home> - The application home directory. In an uninstalled application,
3526 this is the top level application directory. In an installed application,
3527 this will be the directory containing C<< MyApp.pm >>.
3528
3529 =item *
3530
3531 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3532
3533 =item *
3534
3535 C<name> - The name of the application in debug messages and the debug and
3536 welcome screens
3537
3538 =item *
3539
3540 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3541 until it is accessed. This allows you to (for example) check authentication (and reject
3542 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
3543
3544 =item *
3545
3546 C<root> - The root directory for templates. Usually this is just a
3547 subdirectory of the home directory, but you can set it to change the
3548 templates to a different directory.
3549
3550 =item *
3551
3552 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3553 namespaces from which components will be loaded (and constructed and stored in
3554 C<< $c->components >>).
3555
3556 =item *
3557
3558 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3559 to be shown in hit debug tables in the test server.
3560
3561 =item *
3562
3563 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
3564 variable should be used for determining the request path. 
3565
3566 Most web server environments pass the requested path to the application using environment variables,
3567 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
3568 exposed as C<< $c->request->base >>) and the request path below that base.
3569
3570 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
3571 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
3572
3573 =over
3574
3575 =item use_request_uri_for_path => 0
3576
3577 This is the default (and the) traditional method that Catalyst has used for determining the path information.
3578 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
3579 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
3580 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
3581
3582 However this method has the major disadvantage that it is impossible to correctly decode some elements
3583 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
3584 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
3585 can't distinguish / vs %2F in paths (in addition to other encoded values).
3586
3587 =item use_request_uri_for_path => 1
3588
3589 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
3590 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
3591 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
3592
3593 Given that this method of path resolution is provably more correct, it is recommended that you use
3594 this unless you have a specific need to deploy your application in a non-standard environment, and you are
3595 aware of the implications of not being able to handle encoded URI paths correctly.
3596
3597 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
3598 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
3599 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
3600 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
3601 C<< $c->request->base >> will be incorrect.
3602
3603 =back 
3604
3605 =item *
3606
3607 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3608
3609 =item *
3610
3611 C<encoding> - See L</ENCODING>
3612
3613 =item *
3614
3615 C<abort_chain_on_error_fix>
3616
3617 When there is an error in an action chain, the default behavior is to continue
3618 processing the remaining actions and then catch the error upon chain end.  This
3619 can lead to running actions when the application is in an unexpected state.  If
3620 you have this issue, setting this config value to true will promptly exit a
3621 chain when there is an error raised in any action (thus terminating the chain 
3622 early.)
3623
3624 use like:
3625
3626     __PACKAGE__->config(abort_chain_on_error_fix => 1);
3627
3628 In the future this might become the default behavior.
3629
3630 =item *
3631
3632 C<use_hash_multivalue_in_request>
3633
3634 In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
3635 and C<parameters> return a hashref where values might be scalar or an arrayref
3636 depending on the incoming data.  In many cases this can be undesirable as it
3637 leads one to writing defensive code like the following:
3638
3639     my ($val) = ref($c->req->parameters->{a}) ?
3640       @{$c->req->parameters->{a}} :
3641         $c->req->parameters->{a};
3642
3643 Setting this configuration item to true will make L<Catalyst> populate the
3644 attributes underlying these methods with an instance of L<Hash::MultiValue>
3645 which is used by L<Plack::Request> and others to solve this very issue.  You
3646 may prefer this behavior to the default, if so enable this option (be warned
3647 if you enable it in a legacy application we are not sure if it is completely
3648 backwardly compatible).
3649
3650 =item *
3651
3652 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
3653
3654 =item *
3655
3656 C<data_handlers> - See L<DATA HANDLERS>.
3657
3658 =back
3659
3660 =head1 EXCEPTIONS
3661
3662 Generally when you throw an exception inside an Action (or somewhere in
3663 your stack, such as in a model that an Action is calling) that exception
3664 is caught by Catalyst and unless you either catch it yourself (via eval
3665 or something like L<Try::Tiny> or by reviewing the L</error> stack, it
3666 will eventually reach L</finalize_errors> and return either the debugging
3667 error stack page, or the default error page.  However, if your exception 
3668 can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
3669 instead rethrow it so that it can be handled by that middleware (which
3670 is part of the default middleware).  For example this would allow
3671
3672     use HTTP::Throwable::Factory 'http_throw';
3673
3674     sub throws_exception :Local {
3675       my ($self, $c) = @_;
3676
3677       http_throw(SeeOther => { location => 
3678         $c->uri_for($self->action_for('redirect')) });
3679
3680     }
3681
3682 =head1 INTERNAL ACTIONS
3683
3684 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3685 C<_ACTION>, and C<_END>. These are by default not shown in the private
3686 action table, but you can make them visible with a config parameter.
3687
3688     MyApp->config(show_internal_actions => 1);
3689
3690 =head1 ON-DEMAND PARSER
3691
3692 The request body is usually parsed at the beginning of a request,
3693 but if you want to handle input yourself, you can enable on-demand
3694 parsing with a config parameter.
3695
3696     MyApp->config(parse_on_demand => 1);
3697
3698 =head1 PROXY SUPPORT
3699
3700 Many production servers operate using the common double-server approach,
3701 with a lightweight frontend web server passing requests to a larger
3702 backend server. An application running on the backend server must deal
3703 with two problems: the remote user always appears to be C<127.0.0.1> and
3704 the server's hostname will appear to be C<localhost> regardless of the
3705 virtual host that the user connected through.
3706
3707 Catalyst will automatically detect this situation when you are running
3708 the frontend and backend servers on the same machine. The following
3709 changes are made to the request.
3710
3711     $c->req->address is set to the user's real IP address, as read from
3712     the HTTP X-Forwarded-For header.
3713
3714     The host value for $c->req->base and $c->req->uri is set to the real
3715     host, as read from the HTTP X-Forwarded-Host header.
3716
3717 Additionally, you may be running your backend application on an insecure
3718 connection (port 80) while your frontend proxy is running under SSL.  If there
3719 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3720 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3721 be created properly.
3722
3723 In the case of passing in:
3724
3725     X-Forwarded-Port: 443
3726
3727 All calls to C<uri_for> will result in an https link, as is expected.
3728
3729 Obviously, your web server must support these headers for this to work.
3730
3731 In a more complex server farm environment where you may have your
3732 frontend proxy server(s) on different machines, you will need to set a
3733 configuration option to tell Catalyst to read the proxied data from the
3734 headers.
3735
3736     MyApp->config(using_frontend_proxy => 1);
3737
3738 If you do not wish to use the proxy support at all, you may set:
3739
3740     MyApp->config(ignore_frontend_proxy => 0);
3741
3742 =head2 Note about psgi files
3743
3744 Note that if you supply your own .psgi file, calling
3745 C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>.
3746
3747 You either need to apply L<Plack::Middleware::ReverseProxy> yourself
3748 in your psgi, for example:
3749
3750     builder {
3751         enable "Plack::Middleware::ReverseProxy";
3752         MyApp->psgi_app
3753     };
3754
3755 This will unconditionally add the ReverseProxy support, or you need to call
3756 C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
3757 apply the support depending upon your config).
3758
3759 See L<Catalyst::PSGI> for more information.
3760
3761 =head1 THREAD SAFETY
3762
3763 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3764 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3765 believe the Catalyst core to be thread-safe.
3766
3767 If you plan to operate in a threaded environment, remember that all other
3768 modules you are using must also be thread-safe. Some modules, most notably
3769 L<DBD::SQLite>, are not thread-safe.
3770
3771 =head1 DATA HANDLERS
3772
3773 The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
3774 form parameters and URL search query fields.  However it has become common
3775 for various alternative content types to be PUT or POSTed to your controllers
3776 and actions.  People working on RESTful APIs, or using AJAX often use JSON,
3777 XML and other content types when communicating with an application server.  In
3778 order to better support this use case, L<Catalyst> defines a global configuration
3779 option, C<data_handlers>, which lets you associate a content type with a coderef
3780 that parses that content type into something Perl can readily access.
3781
3782     package MyApp::Web;
3783  
3784     use Catalyst;
3785     use JSON::Maybe;
3786  
3787     __PACKAGE__->config(
3788       data_handlers => {
3789         'application/json' => sub { local $/; decode_json $_->getline },
3790       },
3791       ## Any other configuration.
3792     );
3793  
3794     __PACKAGE__->setup;
3795
3796 By default L<Catalyst> comes with a generic JSON data handler similar to the
3797 example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
3798 (a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
3799 it installed (if you want the faster XS parser, add it to you project Makefile.PL
3800 or dist.ini, cpanfile, etc.)
3801
3802 The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types
3803 (matched against the incoming request type using a regexp such as to be case
3804 insensitive) and whose values are coderefs that receive a localized version of
3805 C<$_> which is a filehandle object pointing to received body.
3806
3807 This feature is considered an early access release and we reserve the right
3808 to alter the interface in order to provide a performant and secure solution to
3809 alternative request body content.  Your reports welcomed!
3810
3811 =head1 PSGI MIDDLEWARE
3812
3813 You can define middleware, defined as L<Plack::Middleware> or a compatible
3814 interface in configuration.  Your middleware definitions are in the form of an
3815 arrayref under the configuration key C<psgi_middleware>.  Here's an example
3816 with details to follow:
3817
3818     package MyApp::Web;
3819  
3820     use Catalyst;
3821     use Plack::Middleware::StackTrace;
3822  
3823     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3824  
3825     __PACKAGE__->config(
3826       'psgi_middleware', [
3827         'Debug',
3828         '+MyApp::Custom',
3829         $stacktrace_middleware,
3830         'Session' => {store => 'File'},
3831         sub {
3832           my $app = shift;
3833           return sub {
3834             my $env = shift;
3835             $env->{myapp.customkey} = 'helloworld';
3836             $app->($env);
3837           },
3838         },
3839       ],
3840     );
3841  
3842     __PACKAGE__->setup;
3843
3844 So the general form is:
3845
3846     __PACKAGE__->config(psgi_middleware => \@middleware_definitions);
3847
3848 Where C<@middleware> is one or more of the following, applied in the REVERSE of
3849 the order listed (to make it function similarly to L<Plack::Builder>:
3850
3851 Alternatively, you may also define middleware by calling the L</setup_middleware>
3852 package method:
3853
3854     package MyApp::Web;
3855
3856     use Catalyst;
3857
3858     __PACKAGE__->setup_middleware( \@middleware_definitions);
3859     __PACKAGE__->setup;
3860
3861 In the case where you do both (use 'setup_middleware' and configuration) the
3862 package call to setup_middleware will be applied earlier (in other words its
3863 middleware will wrap closer to the application).  Keep this in mind since in
3864 some cases the order of middleware is important.
3865
3866 The two approaches are not exclusive.
3867  
3868 =over 4
3869  
3870 =item Middleware Object
3871  
3872 An already initialized object that conforms to the L<Plack::Middleware>
3873 specification:
3874  
3875     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3876  
3877     __PACKAGE__->config(
3878       'psgi_middleware', [
3879         $stacktrace_middleware,
3880       ]);
3881  
3882  
3883 =item coderef
3884  
3885 A coderef that is an inlined middleware:
3886  
3887     __PACKAGE__->config(
3888       'psgi_middleware', [
3889         sub {
3890           my $app = shift;
3891           return sub {
3892             my $env = shift;
3893             if($env->{PATH_INFO} =~m/forced/) {
3894               Plack::App::File
3895                 ->new(file=>TestApp->path_to(qw/share static forced.txt/))
3896                 ->call($env);
3897             } else {
3898               return $app->($env);
3899             }
3900          },
3901       },
3902     ]);
3903  
3904  
3905  
3906 =item a scalar
3907  
3908 We assume the scalar refers to a namespace after normalizing it using the
3909 following rules:
3910
3911 (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string
3912 is assumed to be 'as is', and we just install and use the middleware.
3913
3914 (2) If the scalar begins with "Plack::Middleware" or your application namespace
3915 (the package name of your Catalyst application subclass), we also assume then
3916 that it is a full namespace, and use it.
3917
3918 (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to
3919 resolve it first by looking for it under your application namespace (for example
3920 if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look
3921 under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we
3922 will then look under the regular L<Plack::Middleware> namespace (i.e. for the
3923 previous we'd try "Plack::Middleware::MyMiddleware").  We look under your application
3924 namespace first to let you 'override' common L<Plack::Middleware> locally, should
3925 you find that a good idea.
3926
3927 Examples:
3928
3929     package MyApp::Web;
3930
3931     __PACKAGE__->config(
3932       'psgi_middleware', [
3933         'Debug',  ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap
3934         'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap
3935         '+MyApp::Custom',  ## MyApp::Custom->wrap
3936       ],
3937     );
3938  
3939 =item a scalar followed by a hashref
3940  
3941 Just like the previous, except the following C<HashRef> is used as arguments
3942 to initialize the middleware object.
3943  
3944     __PACKAGE__->config(
3945       'psgi_middleware', [
3946          'Session' => {store => 'File'},
3947     ]);
3948
3949 =back
3950
3951 Please see L<PSGI> for more on middleware.
3952
3953 =head1 ENCODING
3954
3955 On request, decodes all params from encoding into a sequence of
3956 logical characters. On response, encodes body into encoding.
3957
3958 =head2 Methods
3959
3960 =over 4
3961
3962 =item encoding
3963
3964 Returns an instance of an C<Encode> encoding
3965
3966     print $c->encoding->name
3967
3968 =item handle_unicode_encoding_exception ($exception_context)
3969
3970 Method called when decoding process for a request fails.
3971
3972 An C<$exception_context> hashref is provided to allow you to override the
3973 behaviour of your application when given data with incorrect encodings.
3974
3975 The default method throws exceptions in the case of invalid request parameters
3976 (resulting in a 500 error), but ignores errors in upload filenames.
3977
3978 The keys passed in the C<$exception_context> hash are:
3979
3980 =over
3981
3982 =item param_value
3983
3984 The value which was not able to be decoded.
3985
3986 =item error_msg
3987
3988 The exception received from L<Encode>.
3989
3990 =item encoding_step
3991
3992 What type of data was being decoded. Valid values are (currently)
3993 C<params> - for request parameters / arguments / captures
3994 and C<uploads> - for request upload filenames.
3995
3996 =back
3997
3998 =back
3999
4000 =head1 SUPPORT
4001
4002 IRC:
4003
4004     Join #catalyst on irc.perl.org.
4005
4006 Mailing Lists:
4007
4008     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
4009     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
4010
4011 Web:
4012
4013     http://catalyst.perl.org
4014
4015 Wiki:
4016
4017     http://dev.catalyst.perl.org
4018
4019 =head1 SEE ALSO
4020
4021 =head2 L<Task::Catalyst> - All you need to start with Catalyst
4022
4023 =head2 L<Catalyst::Manual> - The Catalyst Manual
4024
4025 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
4026
4027 =head2 L<Catalyst::Engine> - Core engine
4028
4029 =head2 L<Catalyst::Log> - Log class.
4030
4031 =head2 L<Catalyst::Request> - Request object
4032
4033 =head2 L<Catalyst::Response> - Response object
4034
4035 =head2 L<Catalyst::Test> - The test suite.
4036
4037 =head1 PROJECT FOUNDER
4038
4039 sri: Sebastian Riedel <sri@cpan.org>
4040
4041 =head1 CONTRIBUTORS
4042
4043 abw: Andy Wardley
4044
4045 acme: Leon Brocard <leon@astray.com>
4046
4047 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
4048
4049 Andrew Bramble
4050
4051 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
4052
4053 Andrew Ruthven
4054
4055 andyg: Andy Grundman <andy@hybridized.org>
4056
4057 audreyt: Audrey Tang
4058
4059 bricas: Brian Cassidy <bricas@cpan.org>
4060
4061 Caelum: Rafael Kitover <rkitover@io.com>
4062
4063 chansen: Christian Hansen
4064
4065 chicks: Christopher Hicks
4066
4067 Chisel Wright C<pause@herlpacker.co.uk>
4068
4069 Danijel Milicevic C<me@danijel.de>
4070
4071 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
4072
4073 David Naughton, C<naughton@umn.edu>
4074
4075 David E. Wheeler
4076
4077 dhoss: Devin Austin <dhoss@cpan.org>
4078
4079 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
4080
4081 Drew Taylor
4082
4083 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
4084
4085 esskar: Sascha Kiefer
4086
4087 fireartist: Carl Franks <cfranks@cpan.org>
4088
4089 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
4090
4091 gabb: Danijel Milicevic
4092
4093 Gary Ashton Jones
4094
4095 Gavin Henry C<ghenry@perl.me.uk>
4096
4097 Geoff Richards
4098
4099 groditi: Guillermo Roditi <groditi@gmail.com>
4100
4101 hobbs: Andrew Rodland <andrew@cleverdomain.org>
4102
4103 ilmari: Dagfinn Ilmari MannsÃ¥ker <ilmari@ilmari.org>
4104
4105 jcamacho: Juan Camacho
4106
4107 jester: Jesse Sheidlower C<jester@panix.com>
4108
4109 jhannah: Jay Hannah <jay@jays.net>
4110
4111 Jody Belka
4112
4113 Johan Lindstrom
4114
4115 jon: Jon Schutz <jjschutz@cpan.org>
4116
4117 Jonathan Rockway C<< <jrockway@cpan.org> >>
4118
4119 Kieren Diment C<kd@totaldatasolution.com>
4120
4121 konobi: Scott McWhirter <konobi@cpan.org>
4122
4123 marcus: Marcus Ramberg <mramberg@cpan.org>
4124
4125 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
4126
4127 mgrimes: Mark Grimes <mgrimes@cpan.org>
4128
4129 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
4130
4131 mugwump: Sam Vilain
4132
4133 naughton: David Naughton
4134
4135 ningu: David Kamholz <dkamholz@cpan.org>
4136
4137 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
4138
4139 numa: Dan Sully <daniel@cpan.org>
4140
4141 obra: Jesse Vincent
4142
4143 Octavian Rasnita
4144
4145 omega: Andreas Marienborg
4146
4147 Oleg Kostyuk <cub.uanic@gmail.com>
4148
4149 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
4150
4151 rafl: Florian Ragwitz <rafl@debian.org>
4152
4153 random: Roland Lammel <lammel@cpan.org>
4154
4155 Robert Sedlacek C<< <rs@474.at> >>
4156
4157 SpiceMan: Marcel Montes
4158
4159 sky: Arthur Bergman
4160
4161 szbalint: Balint Szilakszi <szbalint@cpan.org>
4162
4163 t0m: Tomas Doran <bobtfish@bobtfish.net>
4164
4165 Ulf Edvinsson
4166
4167 vanstyn: Henry Van Styn <vanstyn@cpan.org>
4168
4169 Viljo Marrandi C<vilts@yahoo.com>
4170
4171 Will Hawes C<info@whawes.co.uk>
4172
4173 willert: Sebastian Willert <willert@cpan.org>
4174
4175 wreis: Wallace Reis <wreis@cpan.org>
4176
4177 Yuval Kogman, C<nothingmuch@woobling.org>
4178
4179 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
4180
4181 dd070: Dhaval Dhanani <dhaval070@gmail.com>
4182
4183 Upasana <me@upasana.me>
4184
4185 =head1 COPYRIGHT
4186
4187 Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
4188
4189 =head1 LICENSE
4190
4191 This library is free software. You can redistribute it and/or modify it under
4192 the same terms as Perl itself.
4193
4194 =cut
4195
4196 no Moose;
4197
4198 __PACKAGE__->meta->make_immutable;
4199
4200 1;