lib/Catalyst.pm

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