lib/Catalyst.pm

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