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