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