lib/Catalyst.pm

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