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