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