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