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