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