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