lib/Catalyst.pm

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