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