lib/Catalyst.pm

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