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.90073';
 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(blessed $error && ($error->can('as_psgi') || $error->can('code'))) {
1779             foreach my $err (@{$c->error}) {
1780                 $c->log->error($err);
1781             }
1782             $c->clear_errors;
1783             $c->log->_flush if $c->log->can('_flush');
1784
1785             $error->can('rethrow') ? $error->rethrow : croak $error;
1786         }
1787         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1788             $error->rethrow if $c->depth > 1;
1789         }
1790         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1791             $error->rethrow if $c->depth > 0;
1792         }
1793         else {
1794             unless ( ref $error ) {
1795                 no warnings 'uninitialized';
1796                 chomp $error;
1797                 my $class = $last->class;
1798                 my $name  = $last->name;
1799                 $error = qq/Caught exception in $class->$name "$error"/;
1800             }
1801             $c->error($error);
1802         }
1803         $c->state(0);
1804     }
1805     return $c->state;
1806 }
1807
1808 sub _stats_start_execute {
1809     my ( $c, $code ) = @_;
1810     my $appclass = ref($c) || $c;
1811     return if ( ( $code->name =~ /^_.*/ )
1812         && ( !$appclass->config->{show_internal_actions} ) );
1813
1814     my $action_name = $code->reverse();
1815     $c->counter->{$action_name}++;
1816
1817     my $action = $action_name;
1818     $action = "/$action" unless $action =~ /->/;
1819
1820     # determine if the call was the result of a forward
1821     # this is done by walking up the call stack and looking for a calling
1822     # sub of Catalyst::forward before the eval
1823     my $callsub = q{};
1824     for my $index ( 2 .. 11 ) {
1825         last
1826         if ( ( caller($index) )[0] eq 'Catalyst'
1827             && ( caller($index) )[3] eq '(eval)' );
1828
1829         if ( ( caller($index) )[3] =~ /forward$/ ) {
1830             $callsub = ( caller($index) )[3];
1831             $action  = "-> $action";
1832             last;
1833         }
1834     }
1835
1836     my $uid = $action_name . $c->counter->{$action_name};
1837
1838     # is this a root-level call or a forwarded call?
1839     if ( $callsub =~ /forward$/ ) {
1840         my $parent = $c->stack->[-1];
1841
1842         # forward, locate the caller
1843         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1844             $c->stats->profile(
1845                 begin  => $action,
1846                 parent => "$parent" . $c->counter->{"$parent"},
1847                 uid    => $uid,
1848             );
1849         }
1850         else {
1851
1852             # forward with no caller may come from a plugin
1853             $c->stats->profile(
1854                 begin => $action,
1855                 uid   => $uid,
1856             );
1857         }
1858     }
1859     else {
1860
1861         # root-level call
1862         $c->stats->profile(
1863             begin => $action,
1864             uid   => $uid,
1865         );
1866     }
1867     return $action;
1868
1869 }
1870
1871 sub _stats_finish_execute {
1872     my ( $c, $info ) = @_;
1873     $c->stats->profile( end => $info );
1874 }
1875
1876 =head2 $c->finalize
1877
1878 Finalizes the request.
1879
1880 =cut
1881
1882 sub finalize {
1883     my $c = shift;
1884
1885     for my $error ( @{ $c->error } ) {
1886         $c->log->error($error);
1887     }
1888
1889     # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
1890     # stuff like cometd and websockets
1891
1892     if($c->request->_has_io_fh) {
1893       $c->log_response;
1894       return;
1895     }
1896
1897     # Allow engine to handle finalize flow (for POE)
1898     my $engine = $c->engine;
1899     if ( my $code = $engine->can('finalize') ) {
1900         $engine->$code($c);
1901     }
1902     else {
1903
1904         $c->finalize_uploads;
1905
1906         # Error
1907         if ( $#{ $c->error } >= 0 ) {
1908             $c->finalize_error;
1909         }
1910
1911         $c->finalize_encoding;
1912         $c->finalize_headers unless $c->response->finalized_headers;
1913         $c->finalize_body;
1914     }
1915
1916     $c->log_response;
1917
1918     if ($c->use_stats) {
1919         my $elapsed = $c->stats->elapsed;
1920         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1921         $c->log->info(
1922             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1923     }
1924
1925     return $c->response->status;
1926 }
1927
1928 =head2 $c->finalize_body
1929
1930 Finalizes body.
1931
1932 =cut
1933
1934 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1935
1936 =head2 $c->finalize_cookies
1937
1938 Finalizes cookies.
1939
1940 =cut
1941
1942 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1943
1944 =head2 $c->finalize_error
1945
1946 Finalizes error.  If there is only one error in L</error> and it is an object that
1947 does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
1948 up the ladder.  Otherwise we return the debugging error page (in debug mode) or we
1949 return the default error page (production mode).
1950
1951 =cut
1952
1953 sub finalize_error {
1954     my $c = shift;
1955     if($#{$c->error} > 0) {
1956         $c->engine->finalize_error( $c, @_ );
1957     } else {
1958         my ($error) = @{$c->error};
1959         if(
1960           blessed $error &&
1961           ($error->can('as_psgi') || $error->can('code'))
1962         ) {
1963             # In the case where the error 'knows what it wants', becauses its PSGI
1964             # aware, just rethow and let middleware catch it
1965             $error->can('rethrow') ? $error->rethrow : croak $error;
1966         } else {
1967             $c->engine->finalize_error( $c, @_ )
1968         }
1969     }
1970 }
1971
1972 =head2 $c->finalize_headers
1973
1974 Finalizes headers.
1975
1976 =cut
1977
1978 sub finalize_headers {
1979     my $c = shift;
1980
1981     my $response = $c->response; #accessor calls can add up?
1982
1983     # Check if we already finalized headers
1984     return if $response->finalized_headers;
1985
1986     # Handle redirects
1987     if ( my $location = $response->redirect ) {
1988         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1989         $response->header( Location => $location );
1990     }
1991
1992     # Remove incorrectly added body and content related meta data when returning
1993     # an information response, or a response the is required to not include a body
1994
1995     $c->finalize_cookies;
1996
1997     $c->response->finalize_headers();
1998
1999     # Done
2000     $response->finalized_headers(1);
2001 }
2002
2003 =head2 $c->finalize_encoding
2004
2005 Make sure your headers and body are encoded properly IF you set an encoding.
2006 See L</ENCODING>.
2007
2008 =cut
2009
2010 sub finalize_encoding {
2011     my $c = shift;
2012
2013     my $body = $c->response->body;
2014
2015     return unless defined($body);
2016
2017     my $enc = $c->encoding;
2018
2019     return unless $enc;
2020
2021     my ($ct, $ct_enc) = $c->response->content_type;
2022
2023     # Only touch 'text-like' contents
2024     return unless $c->response->content_type =~ /^text|xml$|javascript$/;
2025
2026     if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
2027         if (uc($1) ne uc($enc->mime_name)) {
2028             $c->log->debug("Unicode::Encoding is set to encode in '" .
2029                            $enc->mime_name .
2030                            "', content type is '$1', not encoding ");
2031             return;
2032         }
2033     } else {
2034         $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
2035     }
2036
2037     # Oh my, I wonder what filehandle responses and streams do... - jnap.
2038     # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
2039     $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) )
2040         if ref(\$body) eq 'SCALAR';
2041 }
2042
2043 =head2 $c->finalize_output
2044
2045 An alias for finalize_body.
2046
2047 =head2 $c->finalize_read
2048
2049 Finalizes the input after reading is complete.
2050
2051 =cut
2052
2053 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2054
2055 =head2 $c->finalize_uploads
2056
2057 Finalizes uploads. Cleans up any temporary files.
2058
2059 =cut
2060
2061 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2062
2063 =head2 $c->get_action( $action, $namespace )
2064
2065 Gets an action in a given namespace.
2066
2067 =cut
2068
2069 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
2070
2071 =head2 $c->get_actions( $action, $namespace )
2072
2073 Gets all actions of a given name in a namespace and all parent
2074 namespaces.
2075
2076 =cut
2077
2078 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2079
2080 =head2 $app->handle_request( @arguments )
2081
2082 Called to handle each HTTP request.
2083
2084 =cut
2085
2086 sub handle_request {
2087     my ( $class, @arguments ) = @_;
2088
2089     # Always expect worst case!
2090     my $status = -1;
2091     try {
2092         if ($class->debug) {
2093             my $secs = time - $START || 1;
2094             my $av = sprintf '%.3f', $COUNT / $secs;
2095             my $time = localtime time;
2096             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
2097         }
2098
2099         my $c = $class->prepare(@arguments);
2100         $c->dispatch;
2101         $status = $c->finalize;
2102     } catch {
2103         #rethow if this can be handled by middleware
2104         if(blessed $_ && ($_->can('as_psgi') || $_->can('code'))) {
2105             $_->can('rethrow') ? $_->rethrow : croak $_;
2106         }
2107         chomp(my $error = $_);
2108         $class->log->error(qq/Caught exception in engine "$error"/);
2109     };
2110
2111     $COUNT++;
2112
2113     if(my $coderef = $class->log->can('_flush')){
2114         $class->log->$coderef();
2115     }
2116     return $status;
2117 }
2118
2119 =head2 $class->prepare( @arguments )
2120
2121 Creates a Catalyst context from an engine-specific request (Apache, CGI,
2122 etc.).
2123
2124 =cut
2125
2126 has _uploadtmp => (
2127     is => 'ro',
2128     predicate => '_has_uploadtmp',
2129 );
2130
2131 sub prepare {
2132     my ( $class, @arguments ) = @_;
2133
2134     # XXX
2135     # After the app/ctxt split, this should become an attribute based on something passed
2136     # into the application.
2137     $class->context_class( ref $class || $class ) unless $class->context_class;
2138
2139     my $uploadtmp = $class->config->{uploadtmp};
2140     my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
2141
2142     $c->response->_context($c);
2143
2144     #surely this is not the most efficient way to do things...
2145     $c->stats($class->stats_class->new)->enable($c->use_stats);
2146     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
2147         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
2148     }
2149
2150     try {
2151         # Allow engine to direct the prepare flow (for POE)
2152         if ( my $prepare = $c->engine->can('prepare') ) {
2153             $c->engine->$prepare( $c, @arguments );
2154         }
2155         else {
2156             $c->prepare_request(@arguments);
2157             $c->prepare_connection;
2158             $c->prepare_query_parameters;
2159             $c->prepare_headers; # Just hooks, no longer needed - they just
2160             $c->prepare_cookies; # cause the lazy attribute on req to build
2161             $c->prepare_path;
2162
2163             # Prepare the body for reading, either by prepare_body
2164             # or the user, if they are using $c->read
2165             $c->prepare_read;
2166
2167             # Parse the body unless the user wants it on-demand
2168             unless ( ref($c)->config->{parse_on_demand} ) {
2169                 $c->prepare_body;
2170             }
2171         }
2172         $c->prepare_action;
2173     }
2174     # VERY ugly and probably shouldn't rely on ->finalize actually working
2175     catch {
2176         # failed prepare is always due to an invalid request, right?
2177         $c->response->status(400);
2178         $c->response->content_type('text/plain');
2179         $c->response->body('Bad Request');
2180         # Note we call finalize and then die here, which escapes
2181         # finalize being called in the enclosing block..
2182         # It in fact couldn't be called, as we don't return $c..
2183         # This is a mess - but I'm unsure you can fix this without
2184         # breaking compat for people doing crazy things (we should set
2185         # the 400 and just return the ctx here IMO, letting finalize get called
2186         # above...
2187         $c->finalize;
2188         die $_;
2189     };
2190
2191     $c->log_request;
2192
2193     return $c;
2194 }
2195
2196 =head2 $c->prepare_action
2197
2198 Prepares action. See L<Catalyst::Dispatcher>.
2199
2200 =cut
2201
2202 sub prepare_action {
2203     my $c = shift;
2204     my $ret = $c->dispatcher->prepare_action( $c, @_);
2205
2206     if($c->encoding) {
2207         foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2208           $_ = $c->_handle_param_unicode_decoding($_);
2209         }
2210     }
2211
2212     return $ret;
2213 }
2214
2215
2216 =head2 $c->prepare_body
2217
2218 Prepares message body.
2219
2220 =cut
2221
2222 sub prepare_body {
2223     my $c = shift;
2224
2225     return if $c->request->_has_body;
2226
2227     # Initialize on-demand data
2228     $c->engine->prepare_body( $c, @_ );
2229     $c->prepare_parameters;
2230     $c->prepare_uploads;
2231 }
2232
2233 =head2 $c->prepare_body_chunk( $chunk )
2234
2235 Prepares a chunk of data before sending it to L<HTTP::Body>.
2236
2237 See L<Catalyst::Engine>.
2238
2239 =cut
2240
2241 sub prepare_body_chunk {
2242     my $c = shift;
2243     $c->engine->prepare_body_chunk( $c, @_ );
2244 }
2245
2246 =head2 $c->prepare_body_parameters
2247
2248 Prepares body parameters.
2249
2250 =cut
2251
2252 sub prepare_body_parameters {
2253     my $c = shift;
2254     $c->engine->prepare_body_parameters( $c, @_ );
2255 }
2256
2257 =head2 $c->prepare_connection
2258
2259 Prepares connection.
2260
2261 =cut
2262
2263 sub prepare_connection {
2264     my $c = shift;
2265     $c->request->prepare_connection($c);
2266 }
2267
2268 =head2 $c->prepare_cookies
2269
2270 Prepares cookies by ensuring that the attribute on the request
2271 object has been built.
2272
2273 =cut
2274
2275 sub prepare_cookies { my $c = shift; $c->request->cookies }
2276
2277 =head2 $c->prepare_headers
2278
2279 Prepares request headers by ensuring that the attribute on the request
2280 object has been built.
2281
2282 =cut
2283
2284 sub prepare_headers { my $c = shift; $c->request->headers }
2285
2286 =head2 $c->prepare_parameters
2287
2288 Prepares parameters.
2289
2290 =cut
2291
2292 sub prepare_parameters {
2293     my $c = shift;
2294     $c->prepare_body_parameters;
2295     $c->engine->prepare_parameters( $c, @_ );
2296 }
2297
2298 =head2 $c->prepare_path
2299
2300 Prepares path and base.
2301
2302 =cut
2303
2304 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2305
2306 =head2 $c->prepare_query_parameters
2307
2308 Prepares query parameters.
2309
2310 =cut
2311
2312 sub prepare_query_parameters {
2313     my $c = shift;
2314
2315     $c->engine->prepare_query_parameters( $c, @_ );
2316 }
2317
2318 =head2 $c->log_request
2319
2320 Writes information about the request to the debug logs.  This includes:
2321
2322 =over 4
2323
2324 =item * Request method, path, and remote IP address
2325
2326 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2327
2328 =item * Request parameters
2329
2330 =item * File uploads
2331
2332 =back
2333
2334 =cut
2335
2336 sub log_request {
2337     my $c = shift;
2338
2339     return unless $c->debug;
2340
2341     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2342     my $request = $dump->[1];
2343
2344     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2345     $method ||= '';
2346     $path = '/' unless length $path;
2347     $address ||= '';
2348     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2349
2350     $c->log_request_headers($request->headers);
2351
2352     if ( my $keywords = $request->query_keywords ) {
2353         $c->log->debug("Query keywords are: $keywords");
2354     }
2355
2356     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2357
2358     $c->log_request_uploads($request);
2359 }
2360
2361 =head2 $c->log_response
2362
2363 Writes information about the response to the debug logs by calling
2364 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2365
2366 =cut
2367
2368 sub log_response {
2369     my $c = shift;
2370
2371     return unless $c->debug;
2372
2373     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2374     my $response = $dump->[1];
2375
2376     $c->log_response_status_line($response);
2377     $c->log_response_headers($response->headers);
2378 }
2379
2380 =head2 $c->log_response_status_line($response)
2381
2382 Writes one line of information about the response to the debug logs.  This includes:
2383
2384 =over 4
2385
2386 =item * Response status code
2387
2388 =item * Content-Type header (if present)
2389
2390 =item * Content-Length header (if present)
2391
2392 =back
2393
2394 =cut
2395
2396 sub log_response_status_line {
2397     my ($c, $response) = @_;
2398
2399     $c->log->debug(
2400         sprintf(
2401             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2402             $response->status                            || 'unknown',
2403             $response->headers->header('Content-Type')   || 'unknown',
2404             $response->headers->header('Content-Length') || 'unknown'
2405         )
2406     );
2407 }
2408
2409 =head2 $c->log_response_headers($headers);
2410
2411 Hook method which can be wrapped by plugins to log the response headers.
2412 No-op in the default implementation.
2413
2414 =cut
2415
2416 sub log_response_headers {}
2417
2418 =head2 $c->log_request_parameters( query => {}, body => {} )
2419
2420 Logs request parameters to debug logs
2421
2422 =cut
2423
2424 sub log_request_parameters {
2425     my $c          = shift;
2426     my %all_params = @_;
2427
2428     return unless $c->debug;
2429
2430     my $column_width = Catalyst::Utils::term_width() - 44;
2431     foreach my $type (qw(query body)) {
2432         my $params = $all_params{$type};
2433         next if ! keys %$params;
2434         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2435         for my $key ( sort keys %$params ) {
2436             my $param = $params->{$key};
2437             my $value = defined($param) ? $param : '';
2438             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2439         }
2440         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2441     }
2442 }
2443
2444 =head2 $c->log_request_uploads
2445
2446 Logs file uploads included in the request to the debug logs.
2447 The parameter name, filename, file type, and file size are all included in
2448 the debug logs.
2449
2450 =cut
2451
2452 sub log_request_uploads {
2453     my $c = shift;
2454     my $request = shift;
2455     return unless $c->debug;
2456     my $uploads = $request->uploads;
2457     if ( keys %$uploads ) {
2458         my $t = Text::SimpleTable->new(
2459             [ 12, 'Parameter' ],
2460             [ 26, 'Filename' ],
2461             [ 18, 'Type' ],
2462             [ 9,  'Size' ]
2463         );
2464         for my $key ( sort keys %$uploads ) {
2465             my $upload = $uploads->{$key};
2466             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2467                 $t->row( $key, $u->filename, $u->type, $u->size );
2468             }
2469         }
2470         $c->log->debug( "File Uploads are:\n" . $t->draw );
2471     }
2472 }
2473
2474 =head2 $c->log_request_headers($headers);
2475
2476 Hook method which can be wrapped by plugins to log the request headers.
2477 No-op in the default implementation.
2478
2479 =cut
2480
2481 sub log_request_headers {}
2482
2483 =head2 $c->log_headers($type => $headers)
2484
2485 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2486
2487 =cut
2488
2489 sub log_headers {
2490     my $c       = shift;
2491     my $type    = shift;
2492     my $headers = shift;    # an HTTP::Headers instance
2493
2494     return unless $c->debug;
2495
2496     my $column_width = Catalyst::Utils::term_width() - 28;
2497     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2498     $headers->scan(
2499         sub {
2500             my ( $name, $value ) = @_;
2501             $t->row( $name, $value );
2502         }
2503     );
2504     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2505 }
2506
2507
2508 =head2 $c->prepare_read
2509
2510 Prepares the input for reading.
2511
2512 =cut
2513
2514 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2515
2516 =head2 $c->prepare_request
2517
2518 Prepares the engine request.
2519
2520 =cut
2521
2522 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2523
2524 =head2 $c->prepare_uploads
2525
2526 Prepares uploads.
2527
2528 =cut
2529
2530 sub prepare_uploads {
2531     my $c = shift;
2532     $c->engine->prepare_uploads( $c, @_ );
2533
2534     my $enc = $c->encoding;
2535     return unless $enc;
2536
2537     # Uggg we hook prepare uploads to do the encoding crap on post and query
2538     # parameters!  Sorry -jnap
2539     for my $key (qw/ parameters query_parameters body_parameters /) {
2540         for my $value ( values %{ $c->request->{$key} } ) {
2541             # N.B. Check if already a character string and if so do not try to double decode.
2542             #      http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html
2543             #      this avoids exception if we have already decoded content, and is _not_ the
2544             #      same as not encoding on output which is bad news (as it does the wrong thing
2545             #      for latin1 chars for example)..
2546             $value = $c->_handle_unicode_decoding($value);
2547         }
2548     }
2549     for my $value ( values %{ $c->request->uploads } ) {
2550         # skip if it fails for uploads, as we don't usually want uploads touched
2551         # in any way
2552         for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) {
2553             $inner_value->{filename} = try {
2554                 $enc->decode( $inner_value->{filename}, $c->_encode_check )
2555             } catch {
2556                 $c->handle_unicode_encoding_exception({
2557                     param_value => $inner_value->{filename},
2558                     error_msg => $_,
2559                     encoding_step => 'uploads',
2560                 });
2561             };
2562         }
2563     }
2564 }
2565
2566 =head2 $c->prepare_write
2567
2568 Prepares the output for writing.
2569
2570 =cut
2571
2572 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2573
2574 =head2 $c->request_class
2575
2576 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2577
2578 =head2 $c->response_class
2579
2580 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2581
2582 =head2 $c->read( [$maxlength] )
2583
2584 Reads a chunk of data from the request body. This method is designed to
2585 be used in a while loop, reading C<$maxlength> bytes on every call.
2586 C<$maxlength> defaults to the size of the request if not specified.
2587
2588 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2589 directly.
2590
2591 Warning: If you use read(), Catalyst will not process the body,
2592 so you will not be able to access POST parameters or file uploads via
2593 $c->request.  You must handle all body parsing yourself.
2594
2595 =cut
2596
2597 sub read { my $c = shift; return $c->request->read( @_ ) }
2598
2599 =head2 $c->run
2600
2601 Starts the engine.
2602
2603 =cut
2604
2605 sub run {
2606   my $app = shift;
2607   $app->_make_immutable_if_needed;
2608   $app->engine_loader->needs_psgi_engine_compat_hack ?
2609     $app->engine->run($app, @_) :
2610       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2611 }
2612
2613 sub _make_immutable_if_needed {
2614     my $class = shift;
2615     my $meta = find_meta($class);
2616     my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2617     if (
2618         $meta->is_immutable
2619         && ! { $meta->immutable_options }->{replace_constructor}
2620         && $isa_ca
2621     ) {
2622         warn("You made your application class ($class) immutable, "
2623             . "but did not inline the\nconstructor. "
2624             . "This will break catalyst, as your app \@ISA "
2625             . "Class::Accessor(::Fast)?\nPlease pass "
2626             . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2627     }
2628     unless ($meta->is_immutable) {
2629         # XXX - FIXME warning here as you should make your app immutable yourself.
2630         $meta->make_immutable(
2631             replace_constructor => 1,
2632         );
2633     }
2634 }
2635
2636 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2637
2638 Sets an action in a given namespace.
2639
2640 =cut
2641
2642 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2643
2644 =head2 $c->setup_actions($component)
2645
2646 Sets up actions for a component.
2647
2648 =cut
2649
2650 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2651
2652 =head2 $c->setup_components
2653
2654 This method is called internally to set up the application's components.
2655
2656 It finds modules by calling the L<locate_components> method, expands them to
2657 package names with the L<expand_component_module> method, and then installs
2658 each component into the application.
2659
2660 The C<setup_components> config option is passed to both of the above methods.
2661
2662 Installation of each component is performed by the L<setup_component> method,
2663 below.
2664
2665 =cut
2666
2667 sub setup_components {
2668     my $class = shift;
2669
2670     my $config  = $class->config->{ setup_components };
2671
2672     my @comps = $class->locate_components($config);
2673     my %comps = map { $_ => 1 } @comps;
2674
2675     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2676     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2677         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2678     ) if $deprecatedcatalyst_component_names;
2679
2680     for my $component ( @comps ) {
2681
2682         # We pass ignore_loaded here so that overlay files for (e.g.)
2683         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2684         # we know M::P::O found a file on disk so this is safe
2685
2686         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2687     }
2688
2689     for my $component (@comps) {
2690         my $instance = $class->components->{ $component } = $class->setup_component($component);
2691         my @expanded_components = $instance->can('expand_modules')
2692             ? $instance->expand_modules( $component, $config )
2693             : $class->expand_component_module( $component, $config );
2694         for my $component (@expanded_components) {
2695             next if $comps{$component};
2696             $class->components->{ $component } = $class->setup_component($component);
2697         }
2698     }
2699 }
2700
2701 =head2 $c->locate_components( $setup_component_config )
2702
2703 This method is meant to provide a list of component modules that should be
2704 setup for the application.  By default, it will use L<Module::Pluggable>.
2705
2706 Specify a C<setup_components> config option to pass additional options directly
2707 to L<Module::Pluggable>. To add additional search paths, specify a key named
2708 C<search_extra> as an array reference. Items in the array beginning with C<::>
2709 will have the application class name prepended to them.
2710
2711 =cut
2712
2713 sub locate_components {
2714     my $class  = shift;
2715     my $config = shift;
2716
2717     my @paths   = qw( ::M ::Model ::V ::View ::C ::Controller );
2718     my $extra   = delete $config->{ search_extra } || [];
2719
2720     unshift @paths, @$extra;
2721
2722     my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new(
2723       search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ],
2724       %$config
2725     )->plugins } @paths;
2726
2727     return @comps;
2728 }
2729
2730 =head2 $c->expand_component_module( $component, $setup_component_config )
2731
2732 Components found by C<locate_components> will be passed to this method, which
2733 is expected to return a list of component (package) names to be set up.
2734
2735 =cut
2736
2737 sub expand_component_module {
2738     my ($class, $module) = @_;
2739     return Devel::InnerPackage::list_packages( $module );
2740 }
2741
2742 =head2 $c->setup_component
2743
2744 =cut
2745
2746 sub setup_component {
2747     my( $class, $component ) = @_;
2748
2749     unless ( $component->can( 'COMPONENT' ) ) {
2750         return $component;
2751     }
2752
2753     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2754     my $config = $class->config->{ $suffix } || {};
2755     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2756     # methods also pass it. local to avoid pointlessly shitting in config
2757     # for the debug screen, as $component is already the key name.
2758     local $config->{catalyst_component_name} = $component;
2759
2760     my $instance = eval { $component->COMPONENT( $class, $config ); };
2761
2762     if ( my $error = $@ ) {
2763         chomp $error;
2764         Catalyst::Exception->throw(
2765             message => qq/Couldn't instantiate component "$component", "$error"/
2766         );
2767     }
2768
2769     unless (blessed $instance) {
2770         my $metaclass = Moose::Util::find_meta($component);
2771         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2772         my $component_method_from = $method_meta->associated_metaclass->name;
2773         my $value = defined($instance) ? $instance : 'undef';
2774         Catalyst::Exception->throw(
2775             message =>
2776             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2777         );
2778     }
2779     return $instance;
2780 }
2781
2782 =head2 $c->setup_dispatcher
2783
2784 Sets up dispatcher.
2785
2786 =cut
2787
2788 sub setup_dispatcher {
2789     my ( $class, $dispatcher ) = @_;
2790
2791     if ($dispatcher) {
2792         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2793     }
2794
2795     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2796         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2797     }
2798
2799     unless ($dispatcher) {
2800         $dispatcher = $class->dispatcher_class;
2801     }
2802
2803     load_class($dispatcher);
2804
2805     # dispatcher instance
2806     $class->dispatcher( $dispatcher->new );
2807 }
2808
2809 =head2 $c->setup_engine
2810
2811 Sets up engine.
2812
2813 =cut
2814
2815 sub engine_class {
2816     my ($class, $requested_engine) = @_;
2817
2818     if (!$class->engine_loader || $requested_engine) {
2819         $class->engine_loader(
2820             Catalyst::EngineLoader->new({
2821                 application_name => $class,
2822                 (defined $requested_engine
2823                      ? (catalyst_engine_class => $requested_engine) : ()),
2824             }),
2825         );
2826     }
2827
2828     $class->engine_loader->catalyst_engine_class;
2829 }
2830
2831 sub setup_engine {
2832     my ($class, $requested_engine) = @_;
2833
2834     my $engine = do {
2835         my $loader = $class->engine_loader;
2836
2837         if (!$loader || $requested_engine) {
2838             $loader = Catalyst::EngineLoader->new({
2839                 application_name => $class,
2840                 (defined $requested_engine
2841                      ? (requested_engine => $requested_engine) : ()),
2842             }),
2843
2844             $class->engine_loader($loader);
2845         }
2846
2847         $loader->catalyst_engine_class;
2848     };
2849
2850     # Don't really setup_engine -- see _setup_psgi_app for explanation.
2851     return if $class->loading_psgi_file;
2852
2853     load_class($engine);
2854
2855     if ($ENV{MOD_PERL}) {
2856         my $apache = $class->engine_loader->auto;
2857
2858         my $meta = find_meta($class);
2859         my $was_immutable = $meta->is_immutable;
2860         my %immutable_options = $meta->immutable_options;
2861         $meta->make_mutable if $was_immutable;
2862
2863         $meta->add_method(handler => sub {
2864             my $r = shift;
2865             my $psgi_app = $class->_finalized_psgi_app;
2866             $apache->call_app($r, $psgi_app);
2867         });
2868
2869         $meta->make_immutable(%immutable_options) if $was_immutable;
2870     }
2871
2872     $class->engine( $engine->new );
2873
2874     return;
2875 }
2876
2877 ## This exists just to supply a prebuild psgi app for mod_perl and for the
2878 ## build in server support (back compat support for pre psgi port behavior).
2879 ## This is so that we don't build a new psgi app for each request when using
2880 ## the mod_perl handler or the built in servers (http and fcgi, etc).
2881
2882 sub _finalized_psgi_app {
2883     my ($app) = @_;
2884
2885     unless ($app->_psgi_app) {
2886         my $psgi_app = $app->_setup_psgi_app;
2887         $app->_psgi_app($psgi_app);
2888     }
2889
2890     return $app->_psgi_app;
2891 }
2892
2893 ## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the
2894 ## home directory and load that and return it (just assume it is doing the
2895 ## right thing :) ).  If that does not exist, call $app->psgi_app, wrap that
2896 ## in default_middleware and return it ( this is for backward compatibility
2897 ## with pre psgi port behavior ).
2898
2899 sub _setup_psgi_app {
2900     my ($app) = @_;
2901
2902     for my $home (Path::Class::Dir->new($app->config->{home})) {
2903         my $psgi_file = $home->file(
2904             Catalyst::Utils::appprefix($app) . '.psgi',
2905         );
2906
2907         next unless -e $psgi_file;
2908
2909         # If $psgi_file calls ->setup_engine, it's doing so to load
2910         # Catalyst::Engine::PSGI. But if it does that, we're only going to
2911         # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
2912         # anyway. So set a flag (ick) that tells setup_engine not to populate
2913         # $c->engine or do any other things we might regret.
2914
2915         $app->loading_psgi_file(1);
2916         my $psgi_app = Plack::Util::load_psgi($psgi_file);
2917         $app->loading_psgi_file(0);
2918
2919         return $psgi_app
2920             unless $app->engine_loader->needs_psgi_engine_compat_hack;
2921
2922         warn <<"EOW";
2923 Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
2924
2925 Its content has been ignored. Please consult the Catalyst::Upgrading
2926 documentation on how to upgrade from Catalyst::Engine::PSGI.
2927 EOW
2928     }
2929
2930     return $app->apply_default_middlewares($app->psgi_app);
2931 }
2932
2933 =head2 $c->apply_default_middlewares
2934
2935 Adds the following L<Plack> middlewares to your application, since they are
2936 useful and commonly needed:
2937
2938 L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
2939 of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
2940 or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
2941 (if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
2942 applied since this middleware is smart enough to conditionally apply itself).
2943
2944 Additionally if we detect we are using Nginx, we add a bit of custom middleware
2945 to solve some problems with the way that server handles $ENV{PATH_INFO} and
2946 $ENV{SCRIPT_NAME}
2947
2948 =cut
2949
2950
2951 sub apply_default_middlewares {
2952     my ($app, $psgi_app) = @_;
2953
2954     $psgi_app = Plack::Middleware::Conditional->wrap(
2955         $psgi_app,
2956         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2957         condition => sub {
2958             my ($env) = @_;
2959             return if $app->config->{ignore_frontend_proxy};
2960             return $env->{REMOTE_ADDR} eq '127.0.0.1'
2961                 || $app->config->{using_frontend_proxy};
2962         },
2963     );
2964
2965     # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
2966     # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
2967     $psgi_app = Plack::Middleware::Conditional->wrap(
2968         $psgi_app,
2969         builder   => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) },
2970         condition => sub {
2971             my ($env) = @_;
2972             return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!;
2973             return unless $1 < 4.23;
2974             1;
2975         },
2976     );
2977
2978     # we're applying this unconditionally as the middleware itself already makes
2979     # sure it doesn't fuck things up if it's not running under one of the right
2980     # IIS versions
2981     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
2982
2983     # And another IIS issue, this time with IIS7.
2984     $psgi_app = Plack::Middleware::Conditional->wrap(
2985         $psgi_app,
2986         builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
2987         condition => sub {
2988             my ($env) = @_;
2989             return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
2990         },
2991     );
2992
2993     return $psgi_app;
2994 }
2995
2996 =head2 $c->psgi_app
2997
2998 Returns a PSGI application code reference for the catalyst application
2999 C<$c>. This is the bare application without any middlewares
3000 applied. C<${myapp}.psgi> is not taken into account.
3001
3002 This is what you want to be using to retrieve the PSGI application code
3003 reference of your Catalyst application for use in F<.psgi> files.
3004
3005 =cut
3006
3007 sub psgi_app {
3008     my ($app) = @_;
3009     my $psgi = $app->engine->build_psgi_app($app);
3010     return $app->Catalyst::Utils::apply_registered_middleware($psgi);
3011 }
3012
3013 =head2 $c->setup_home
3014
3015 Sets up the home directory.
3016
3017 =cut
3018
3019 sub setup_home {
3020     my ( $class, $home ) = @_;
3021
3022     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
3023         $home = $env;
3024     }
3025
3026     $home ||= Catalyst::Utils::home($class);
3027
3028     if ($home) {
3029         #I remember recently being scolded for assigning config values like this
3030         $class->config->{home} ||= $home;
3031         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
3032     }
3033 }
3034
3035 =head2 $c->setup_encoding
3036
3037 Sets up the input/output encoding.  See L<ENCODING>
3038
3039 =cut
3040
3041 sub setup_encoding {
3042     my $c = shift;
3043     my $enc = delete $c->config->{encoding};
3044     $c->encoding( $enc ) if defined $enc;
3045 }
3046
3047 =head2 handle_unicode_encoding_exception
3048
3049 Hook to let you customize how encoding errors are handled.  By default
3050 we just throw an exception.  Receives a hashref of debug information.
3051 Example:
3052
3053     $c->handle_unicode_encoding_exception({
3054         param_value => $value,
3055         error_msg => $_,
3056             encoding_step => 'params',
3057         });
3058
3059 =cut
3060
3061 sub handle_unicode_encoding_exception {
3062     my ( $self, $exception_ctx ) = @_;
3063     die $exception_ctx->{error_msg};
3064 }
3065
3066 # Some unicode helpers cargo culted from the old plugin.  These could likely
3067 # be neater.
3068
3069 sub _handle_unicode_decoding {
3070     my ( $self, $value ) = @_;
3071
3072     return unless defined $value;
3073
3074     ## I think this mess is to support the old nested
3075     if ( ref $value eq 'ARRAY' ) {
3076         foreach ( @$value ) {
3077             $_ = $self->_handle_unicode_decoding($_);
3078         }
3079         return $value;
3080     }
3081     elsif ( ref $value eq 'HASH' ) {
3082         foreach ( values %$value ) {
3083             $_ = $self->_handle_unicode_decoding($_);
3084         }
3085         return $value;
3086     }
3087     else {
3088         return $self->_handle_param_unicode_decoding($value);
3089     }
3090 }
3091
3092 sub _handle_param_unicode_decoding {
3093     my ( $self, $value ) = @_;
3094     return unless defined $value; # not in love with just ignoring undefs - jnap
3095
3096     my $enc = $self->encoding;
3097     return try {
3098         Encode::is_utf8( $value ) ?
3099             $value
3100         : $enc->decode( $value, $self->_encode_check );
3101     }
3102     catch {
3103         $self->handle_unicode_encoding_exception({
3104             param_value => $value,
3105             error_msg => $_,
3106             encoding_step => 'params',
3107         });
3108     };
3109 }
3110
3111 =head2 $c->setup_log
3112
3113 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
3114 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
3115 log to.
3116
3117 This method also installs a C<debug> method that returns a true value into the
3118 catalyst subclass if the "debug" level is passed in the comma-delimited list,
3119 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
3120
3121 Note that if the log has already been setup, by either a previous call to
3122 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
3123 that this method won't actually set up the log object.
3124
3125 =cut
3126
3127 sub setup_log {
3128     my ( $class, $levels ) = @_;
3129
3130     $levels ||= '';
3131     $levels =~ s/^\s+//;
3132     $levels =~ s/\s+$//;
3133     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
3134
3135     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
3136     if ( defined $env_debug ) {
3137         $levels{debug} = 1 if $env_debug; # Ugly!
3138         delete($levels{debug}) unless $env_debug;
3139     }
3140
3141     unless ( $class->log ) {
3142         $class->log( Catalyst::Log->new(keys %levels) );
3143     }
3144
3145     if ( $levels{debug} ) {
3146         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
3147         $class->log->debug('Debug messages enabled');
3148     }
3149 }
3150
3151 =head2 $c->setup_plugins
3152
3153 Sets up plugins.
3154
3155 =cut
3156
3157 =head2 $c->setup_stats
3158
3159 Sets up timing statistics class.
3160
3161 =cut
3162
3163 sub setup_stats {
3164     my ( $class, $stats ) = @_;
3165
3166     Catalyst::Utils::ensure_class_loaded($class->stats_class);
3167
3168     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
3169     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
3170         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
3171         $class->log->debug('Statistics enabled');
3172     }
3173 }
3174
3175
3176 =head2 $c->registered_plugins
3177
3178 Returns a sorted list of the plugins which have either been stated in the
3179 import list.
3180
3181 If passed a given plugin name, it will report a boolean value indicating
3182 whether or not that plugin is loaded.  A fully qualified name is required if
3183 the plugin name does not begin with C<Catalyst::Plugin::>.
3184
3185  if ($c->registered_plugins('Some::Plugin')) {
3186      ...
3187  }
3188
3189 =cut
3190
3191 {
3192
3193     sub registered_plugins {
3194         my $proto = shift;
3195         return sort keys %{ $proto->_plugins } unless @_;
3196         my $plugin = shift;
3197         return 1 if exists $proto->_plugins->{$plugin};
3198         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
3199     }
3200
3201     sub _register_plugin {
3202         my ( $proto, $plugin, $instant ) = @_;
3203         my $class = ref $proto || $proto;
3204
3205         load_class( $plugin );
3206         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
3207             if $plugin->isa( 'Catalyst::Component' );
3208         my $plugin_meta = Moose::Meta::Class->create($plugin);
3209         if (!$plugin_meta->has_method('new')
3210             && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
3211             $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
3212         }
3213         if (!$instant && !$proto->_plugins->{$plugin}) {
3214             my $meta = Class::MOP::get_metaclass_by_name($class);
3215             $meta->superclasses($plugin, $meta->superclasses);
3216         }
3217         $proto->_plugins->{$plugin} = 1;
3218         return $class;
3219     }
3220
3221     sub _default_plugins { return qw() }
3222
3223     sub setup_plugins {
3224         my ( $class, $plugins ) = @_;
3225
3226         $class->_plugins( {} ) unless $class->_plugins;
3227         $plugins = [ grep {
3228             m/Unicode::Encoding/ ? do {
3229                 $class->log->warn(
3230                     'Unicode::Encoding plugin is auto-applied,'
3231                     . ' please remove this from your appclass'
3232                     . ' and make sure to define "encoding" config'
3233                 );
3234                 unless (exists $class->config->{'encoding'}) {
3235                   $class->config->{'encoding'} = 'UTF-8';
3236                 }
3237                 () }
3238                 : $_
3239         } @$plugins ];
3240         push @$plugins, $class->_default_plugins;
3241         $plugins = Data::OptList::mkopt($plugins || []);
3242
3243         my @plugins = map {
3244             [ Catalyst::Utils::resolve_namespace(
3245                   $class . '::Plugin',
3246                   'Catalyst::Plugin', $_->[0]
3247               ),
3248               $_->[1],
3249             ]
3250          } @{ $plugins };
3251
3252         for my $plugin ( reverse @plugins ) {
3253             load_class($plugin->[0], $plugin->[1]);
3254             my $meta = find_meta($plugin->[0]);
3255             next if $meta && $meta->isa('Moose::Meta::Role');
3256
3257             $class->_register_plugin($plugin->[0]);
3258         }
3259
3260         my @roles =
3261             map  { $_->[0]->name, $_->[1] }
3262             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
3263             map  { [find_meta($_->[0]), $_->[1]] }
3264             @plugins;
3265
3266         Moose::Util::apply_all_roles(
3267             $class => @roles
3268         ) if @roles;
3269     }
3270 }
3271
3272 =head2 registered_middlewares
3273
3274 Read only accessor that returns an array of all the middleware in the order
3275 that they were added (which is the REVERSE of the order they will be applied).
3276
3277 The values returned will be either instances of L<Plack::Middleware> or of a
3278 compatible interface, or a coderef, which is assumed to be inlined middleware
3279
3280 =head2 setup_middleware (?@middleware)
3281
3282 Read configuration information stored in configuration key C<psgi_middleware> or
3283 from passed @args.
3284
3285 See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
3286 to use it to enable L<Plack::Middleware>
3287
3288 This method is automatically called during 'setup' of your application, so
3289 you really don't need to invoke it.  However you may do so if you find the idea
3290 of loading middleware via configuration weird :).  For example:
3291
3292     package MyApp;
3293
3294     use Catalyst;
3295
3296     __PACKAGE__->setup_middleware('Head');
3297     __PACKAGE__->setup;
3298
3299 When we read middleware definitions from configuration, we reverse the list
3300 which sounds odd but is likely how you expect it to work if you have prior
3301 experience with L<Plack::Builder> or if you previously used the plugin
3302 L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
3303
3304 So basically your middleware handles an incoming request from the first
3305 registered middleware, down and handles the response from the last middleware
3306 up.
3307
3308 =cut
3309
3310 sub registered_middlewares {
3311     my $class = shift;
3312     if(my $middleware = $class->_psgi_middleware) {
3313         return (
3314           Catalyst::Middleware::Stash->new,
3315           Plack::Middleware::HTTPExceptions->new,
3316           Plack::Middleware::RemoveRedundantBody->new,
3317           Plack::Middleware::FixMissingBodyInRedirect->new,
3318           Plack::Middleware::ContentLength->new,
3319           Plack::Middleware::MethodOverride->new,
3320           Plack::Middleware::Head->new,
3321           @$middleware);
3322     } else {
3323         die "You cannot call ->registered_middlewares until middleware has been setup";
3324     }
3325 }
3326
3327 sub setup_middleware {
3328     my $class = shift;
3329     my @middleware_definitions = @_ ?
3330       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
3331
3332     my @middleware = ();
3333     while(my $next = shift(@middleware_definitions)) {
3334         if(ref $next) {
3335             if(Scalar::Util::blessed $next && $next->can('wrap')) {
3336                 push @middleware, $next;
3337             } elsif(ref $next eq 'CODE') {
3338                 push @middleware, $next;
3339             } elsif(ref $next eq 'HASH') {
3340                 my $namespace = shift @middleware_definitions;
3341                 my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
3342                 push @middleware, $mw;
3343             } else {
3344               die "I can't handle middleware definition ${\ref $next}";
3345             }
3346         } else {
3347           my $mw = $class->Catalyst::Utils::build_middleware($next);
3348           push @middleware, $mw;
3349         }
3350     }
3351
3352     my @existing = @{$class->_psgi_middleware || []};
3353     $class->_psgi_middleware([@middleware,@existing,]);
3354 }
3355
3356 =head2 registered_data_handlers
3357
3358 A read only copy of registered Data Handlers returned as a Hash, where each key
3359 is a content type and each value is a subref that attempts to decode that content
3360 type.
3361
3362 =head2 setup_data_handlers (?@data_handler)
3363
3364 Read configuration information stored in configuration key C<data_handlers> or
3365 from passed @args.
3366
3367 See under L</CONFIGURATION> information regarding C<data_handlers>.
3368
3369 This method is automatically called during 'setup' of your application, so
3370 you really don't need to invoke it.
3371
3372 =head2 default_data_handlers
3373
3374 Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
3375 only two default data handlers, for 'application/json' and an alternative to
3376 'application/x-www-form-urlencoded' which supposed nested form parameters via
3377 L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
3378
3379 The 'application/json' data handler is used to parse incoming JSON into a Perl
3380 data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
3381 is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
3382 JSON decoder, and has the smallest dependency impact.
3383
3384 Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
3385 use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
3386 order to get the best performance.  You should add either to your dependency
3387 list (Makefile.PL, dist.ini, cpanfile, etc.)
3388
3389 =cut
3390
3391 sub registered_data_handlers {
3392     my $class = shift;
3393     if(my $data_handlers = $class->_data_handlers) {
3394         return %$data_handlers;
3395     } else {
3396         $class->setup_data_handlers;
3397         return $class->registered_data_handlers;
3398     }
3399 }
3400
3401 sub setup_data_handlers {
3402     my ($class, %data_handler_callbacks) = @_;
3403     %data_handler_callbacks = (
3404       %{$class->default_data_handlers},
3405       %{$class->config->{'data_handlers'}||+{}},
3406       %data_handler_callbacks);
3407
3408     $class->_data_handlers(\%data_handler_callbacks);
3409 }
3410
3411 sub default_data_handlers {
3412     my ($class) = @_;
3413     return +{
3414       'application/x-www-form-urlencoded' => sub {
3415           my ($fh, $req) = @_;
3416           my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
3417           Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
3418             ->can('build_cgi_struct')->($params);
3419       },
3420       'application/json' => sub {
3421           Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
3422             ->can('decode_json')->(do { local $/; $_->getline });
3423       },
3424     };
3425 }
3426
3427 =head2 $c->stack
3428
3429 Returns an arrayref of the internal execution stack (actions that are
3430 currently executing).
3431
3432 =head2 $c->stats
3433
3434 Returns the current timing statistics object. By default Catalyst uses
3435 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
3436 L<< stats_class|/"$c->stats_class" >>.
3437
3438 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
3439 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
3440 profile explicitly, although MyApp.pm still won't profile nor output anything
3441 by itself.
3442
3443 =head2 $c->stats_class
3444
3445 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
3446
3447 =head2 $c->use_stats
3448
3449 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
3450
3451 Note that this is a static method, not an accessor and should be overridden
3452 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
3453
3454 =cut
3455
3456 sub use_stats { 0 }
3457
3458
3459 =head2 $c->write( $data )
3460
3461 Writes $data to the output stream. When using this method directly, you
3462 will need to manually set the C<Content-Length> header to the length of
3463 your output data, if known.
3464
3465 =cut
3466
3467 sub write {
3468     my $c = shift;
3469
3470     # Finalize headers if someone manually writes output (for compat)
3471     $c->finalize_headers;
3472
3473     return $c->response->write( @_ );
3474 }
3475
3476 =head2 version
3477
3478 Returns the Catalyst version number. Mostly useful for "powered by"
3479 messages in template systems.
3480
3481 =cut
3482
3483 sub version { return $Catalyst::VERSION }
3484
3485 =head1 CONFIGURATION
3486
3487 There are a number of 'base' config variables which can be set:
3488
3489 =over
3490
3491 =item *
3492
3493 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
3494
3495 =item *
3496
3497 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
3498
3499 =item *
3500
3501 C<disable_component_resolution_regex_fallback> - Turns
3502 off the deprecated component resolution functionality so
3503 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
3504 are called then regex search will not be attempted on string values and
3505 instead C<undef> will be returned.
3506
3507 =item *
3508
3509 C<home> - The application home directory. In an uninstalled application,
3510 this is the top level application directory. In an installed application,
3511 this will be the directory containing C<< MyApp.pm >>.
3512
3513 =item *
3514
3515 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3516
3517 =item *
3518
3519 C<name> - The name of the application in debug messages and the debug and
3520 welcome screens
3521
3522 =item *
3523
3524 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3525 until it is accessed. This allows you to (for example) check authentication (and reject
3526 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
3527
3528 =item *
3529
3530 C<root> - The root directory for templates. Usually this is just a
3531 subdirectory of the home directory, but you can set it to change the
3532 templates to a different directory.
3533
3534 =item *
3535
3536 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3537 namespaces from which components will be loaded (and constructed and stored in
3538 C<< $c->components >>).
3539
3540 =item *
3541
3542 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3543 to be shown in hit debug tables in the test server.
3544
3545 =item *
3546
3547 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
3548 variable should be used for determining the request path.
3549
3550 Most web server environments pass the requested path to the application using environment variables,
3551 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
3552 exposed as C<< $c->request->base >>) and the request path below that base.
3553
3554 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
3555 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
3556
3557 =over
3558
3559 =item use_request_uri_for_path => 0
3560
3561 This is the default (and the) traditional method that Catalyst has used for determining the path information.
3562 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
3563 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
3564 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
3565
3566 However this method has the major disadvantage that it is impossible to correctly decode some elements
3567 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
3568 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
3569 can't distinguish / vs %2F in paths (in addition to other encoded values).
3570
3571 =item use_request_uri_for_path => 1
3572
3573 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
3574 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
3575 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
3576
3577 Given that this method of path resolution is provably more correct, it is recommended that you use
3578 this unless you have a specific need to deploy your application in a non-standard environment, and you are
3579 aware of the implications of not being able to handle encoded URI paths correctly.
3580
3581 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
3582 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
3583 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
3584 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
3585 C<< $c->request->base >> will be incorrect.
3586
3587 =back
3588
3589 =item *
3590
3591 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3592
3593 =item *
3594
3595 C<encoding> - See L</ENCODING>
3596
3597 =item *
3598
3599 C<abort_chain_on_error_fix>
3600
3601 When there is an error in an action chain, the default behavior is to continue
3602 processing the remaining actions and then catch the error upon chain end.  This
3603 can lead to running actions when the application is in an unexpected state.  If
3604 you have this issue, setting this config value to true will promptly exit a
3605 chain when there is an error raised in any action (thus terminating the chain
3606 early.)
3607
3608 use like:
3609
3610     __PACKAGE__->config(abort_chain_on_error_fix => 1);
3611
3612 In the future this might become the default behavior.
3613
3614 =item *
3615
3616 C<use_hash_multivalue_in_request>
3617
3618 In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
3619 and C<parameters> return a hashref where values might be scalar or an arrayref
3620 depending on the incoming data.  In many cases this can be undesirable as it
3621 leads one to writing defensive code like the following:
3622
3623     my ($val) = ref($c->req->parameters->{a}) ?
3624       @{$c->req->parameters->{a}} :
3625         $c->req->parameters->{a};
3626
3627 Setting this configuration item to true will make L<Catalyst> populate the
3628 attributes underlying these methods with an instance of L<Hash::MultiValue>
3629 which is used by L<Plack::Request> and others to solve this very issue.  You
3630 may prefer this behavior to the default, if so enable this option (be warned
3631 if you enable it in a legacy application we are not sure if it is completely
3632 backwardly compatible).
3633
3634 =item *
3635
3636 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
3637
3638 =item *
3639
3640 C<data_handlers> - See L<DATA HANDLERS>.
3641
3642 =back
3643
3644 =head1 EXCEPTIONS
3645
3646 Generally when you throw an exception inside an Action (or somewhere in
3647 your stack, such as in a model that an Action is calling) that exception
3648 is caught by Catalyst and unless you either catch it yourself (via eval
3649 or something like L<Try::Tiny> or by reviewing the L</error> stack, it
3650 will eventually reach L</finalize_errors> and return either the debugging
3651 error stack page, or the default error page.  However, if your exception
3652 can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
3653 instead rethrow it so that it can be handled by that middleware (which
3654 is part of the default middleware).  For example this would allow
3655
3656     use HTTP::Throwable::Factory 'http_throw';
3657
3658     sub throws_exception :Local {
3659       my ($self, $c) = @_;
3660
3661       http_throw(SeeOther => { location =>
3662         $c->uri_for($self->action_for('redirect')) });
3663
3664     }
3665
3666 =head1 INTERNAL ACTIONS
3667
3668 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3669 C<_ACTION>, and C<_END>. These are by default not shown in the private
3670 action table, but you can make them visible with a config parameter.
3671
3672     MyApp->config(show_internal_actions => 1);
3673
3674 =head1 ON-DEMAND PARSER
3675
3676 The request body is usually parsed at the beginning of a request,
3677 but if you want to handle input yourself, you can enable on-demand
3678 parsing with a config parameter.
3679
3680     MyApp->config(parse_on_demand => 1);
3681
3682 =head1 PROXY SUPPORT
3683
3684 Many production servers operate using the common double-server approach,
3685 with a lightweight frontend web server passing requests to a larger
3686 backend server. An application running on the backend server must deal
3687 with two problems: the remote user always appears to be C<127.0.0.1> and
3688 the server's hostname will appear to be C<localhost> regardless of the
3689 virtual host that the user connected through.
3690
3691 Catalyst will automatically detect this situation when you are running
3692 the frontend and backend servers on the same machine. The following
3693 changes are made to the request.
3694
3695     $c->req->address is set to the user's real IP address, as read from
3696     the HTTP X-Forwarded-For header.
3697
3698     The host value for $c->req->base and $c->req->uri is set to the real
3699     host, as read from the HTTP X-Forwarded-Host header.
3700
3701 Additionally, you may be running your backend application on an insecure
3702 connection (port 80) while your frontend proxy is running under SSL.  If there
3703 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3704 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3705 be created properly.
3706
3707 In the case of passing in:
3708
3709     X-Forwarded-Port: 443
3710
3711 All calls to C<uri_for> will result in an https link, as is expected.
3712
3713 Obviously, your web server must support these headers for this to work.
3714
3715 In a more complex server farm environment where you may have your
3716 frontend proxy server(s) on different machines, you will need to set a
3717 configuration option to tell Catalyst to read the proxied data from the
3718 headers.
3719
3720     MyApp->config(using_frontend_proxy => 1);
3721
3722 If you do not wish to use the proxy support at all, you may set:
3723
3724     MyApp->config(ignore_frontend_proxy => 0);
3725
3726 =head2 Note about psgi files
3727
3728 Note that if you supply your own .psgi file, calling
3729 C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>.
3730
3731 You either need to apply L<Plack::Middleware::ReverseProxy> yourself
3732 in your psgi, for example:
3733
3734     builder {
3735         enable "Plack::Middleware::ReverseProxy";
3736         MyApp->psgi_app
3737     };
3738
3739 This will unconditionally add the ReverseProxy support, or you need to call
3740 C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
3741 apply the support depending upon your config).
3742
3743 See L<Catalyst::PSGI> for more information.
3744
3745 =head1 THREAD SAFETY
3746
3747 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3748 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3749 believe the Catalyst core to be thread-safe.
3750
3751 If you plan to operate in a threaded environment, remember that all other
3752 modules you are using must also be thread-safe. Some modules, most notably
3753 L<DBD::SQLite>, are not thread-safe.
3754
3755 =head1 DATA HANDLERS
3756
3757 The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
3758 form parameters and URL search query fields.  However it has become common
3759 for various alternative content types to be PUT or POSTed to your controllers
3760 and actions.  People working on RESTful APIs, or using AJAX often use JSON,
3761 XML and other content types when communicating with an application server.  In
3762 order to better support this use case, L<Catalyst> defines a global configuration
3763 option, C<data_handlers>, which lets you associate a content type with a coderef
3764 that parses that content type into something Perl can readily access.
3765
3766     package MyApp::Web;
3767
3768     use Catalyst;
3769     use JSON::Maybe;
3770
3771     __PACKAGE__->config(
3772       data_handlers => {
3773         'application/json' => sub { local $/; decode_json $_->getline },
3774       },
3775       ## Any other configuration.
3776     );
3777
3778     __PACKAGE__->setup;
3779
3780 By default L<Catalyst> comes with a generic JSON data handler similar to the
3781 example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
3782 (a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
3783 it installed (if you want the faster XS parser, add it to you project Makefile.PL
3784 or dist.ini, cpanfile, etc.)
3785
3786 The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types
3787 (matched against the incoming request type using a regexp such as to be case
3788 insensitive) and whose values are coderefs that receive a localized version of
3789 C<$_> which is a filehandle object pointing to received body.
3790
3791 This feature is considered an early access release and we reserve the right
3792 to alter the interface in order to provide a performant and secure solution to
3793 alternative request body content.  Your reports welcomed!
3794
3795 =head1 PSGI MIDDLEWARE
3796
3797 You can define middleware, defined as L<Plack::Middleware> or a compatible
3798 interface in configuration.  Your middleware definitions are in the form of an
3799 arrayref under the configuration key C<psgi_middleware>.  Here's an example
3800 with details to follow:
3801
3802     package MyApp::Web;
3803
3804     use Catalyst;
3805     use Plack::Middleware::StackTrace;
3806
3807     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3808
3809     __PACKAGE__->config(
3810       'psgi_middleware', [
3811         'Debug',
3812         '+MyApp::Custom',
3813         $stacktrace_middleware,
3814         'Session' => {store => 'File'},
3815         sub {
3816           my $app = shift;
3817           return sub {
3818             my $env = shift;
3819             $env->{myapp.customkey} = 'helloworld';
3820             $app->($env);
3821           },
3822         },
3823       ],
3824     );
3825
3826     __PACKAGE__->setup;
3827
3828 So the general form is:
3829
3830     __PACKAGE__->config(psgi_middleware => \@middleware_definitions);
3831
3832 Where C<@middleware> is one or more of the following, applied in the REVERSE of
3833 the order listed (to make it function similarly to L<Plack::Builder>:
3834
3835 Alternatively, you may also define middleware by calling the L</setup_middleware>
3836 package method:
3837
3838     package MyApp::Web;
3839
3840     use Catalyst;
3841
3842     __PACKAGE__->setup_middleware( \@middleware_definitions);
3843     __PACKAGE__->setup;
3844
3845 In the case where you do both (use 'setup_middleware' and configuration) the
3846 package call to setup_middleware will be applied earlier (in other words its
3847 middleware will wrap closer to the application).  Keep this in mind since in
3848 some cases the order of middleware is important.
3849
3850 The two approaches are not exclusive.
3851
3852 =over 4
3853
3854 =item Middleware Object
3855
3856 An already initialized object that conforms to the L<Plack::Middleware>
3857 specification:
3858
3859     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3860
3861     __PACKAGE__->config(
3862       'psgi_middleware', [
3863         $stacktrace_middleware,
3864       ]);
3865
3866
3867 =item coderef
3868
3869 A coderef that is an inlined middleware:
3870
3871     __PACKAGE__->config(
3872       'psgi_middleware', [
3873         sub {
3874           my $app = shift;
3875           return sub {
3876             my $env = shift;
3877             if($env->{PATH_INFO} =~m/forced/) {
3878               Plack::App::File
3879                 ->new(file=>TestApp->path_to(qw/share static forced.txt/))
3880                 ->call($env);
3881             } else {
3882               return $app->($env);
3883             }
3884          },
3885       },
3886     ]);
3887
3888
3889
3890 =item a scalar
3891
3892 We assume the scalar refers to a namespace after normalizing it using the
3893 following rules:
3894
3895 (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string
3896 is assumed to be 'as is', and we just install and use the middleware.
3897
3898 (2) If the scalar begins with "Plack::Middleware" or your application namespace
3899 (the package name of your Catalyst application subclass), we also assume then
3900 that it is a full namespace, and use it.
3901
3902 (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to
3903 resolve it first by looking for it under your application namespace (for example
3904 if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look
3905 under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we
3906 will then look under the regular L<Plack::Middleware> namespace (i.e. for the
3907 previous we'd try "Plack::Middleware::MyMiddleware").  We look under your application
3908 namespace first to let you 'override' common L<Plack::Middleware> locally, should
3909 you find that a good idea.
3910
3911 Examples:
3912
3913     package MyApp::Web;
3914
3915     __PACKAGE__->config(
3916       'psgi_middleware', [
3917         'Debug',  ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap
3918         'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap
3919         '+MyApp::Custom',  ## MyApp::Custom->wrap
3920       ],
3921     );
3922
3923 =item a scalar followed by a hashref
3924
3925 Just like the previous, except the following C<HashRef> is used as arguments
3926 to initialize the middleware object.
3927
3928     __PACKAGE__->config(
3929       'psgi_middleware', [
3930          'Session' => {store => 'File'},
3931     ]);
3932
3933 =back
3934
3935 Please see L<PSGI> for more on middleware.
3936
3937 =head1 ENCODING
3938
3939 On request, decodes all params from encoding into a sequence of
3940 logical characters. On response, encodes body into encoding.
3941
3942 =head2 Methods
3943
3944 =over 4
3945
3946 =item encoding
3947
3948 Returns an instance of an C<Encode> encoding
3949
3950     print $c->encoding->name
3951
3952 =item handle_unicode_encoding_exception ($exception_context)
3953
3954 Method called when decoding process for a request fails.
3955
3956 An C<$exception_context> hashref is provided to allow you to override the
3957 behaviour of your application when given data with incorrect encodings.
3958
3959 The default method throws exceptions in the case of invalid request parameters
3960 (resulting in a 500 error), but ignores errors in upload filenames.
3961
3962 The keys passed in the C<$exception_context> hash are:
3963
3964 =over
3965
3966 =item param_value
3967
3968 The value which was not able to be decoded.
3969
3970 =item error_msg
3971
3972 The exception received from L<Encode>.
3973
3974 =item encoding_step
3975
3976 What type of data was being decoded. Valid values are (currently)
3977 C<params> - for request parameters / arguments / captures
3978 and C<uploads> - for request upload filenames.
3979
3980 =back
3981
3982 =back
3983
3984 =head1 SUPPORT
3985
3986 IRC:
3987
3988     Join #catalyst on irc.perl.org.
3989
3990 Mailing Lists:
3991
3992     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
3993     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
3994
3995 Web:
3996
3997     http://catalyst.perl.org
3998
3999 Wiki:
4000
4001     http://dev.catalyst.perl.org
4002
4003 =head1 SEE ALSO
4004
4005 =head2 L<Task::Catalyst> - All you need to start with Catalyst
4006
4007 =head2 L<Catalyst::Manual> - The Catalyst Manual
4008
4009 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
4010
4011 =head2 L<Catalyst::Engine> - Core engine
4012
4013 =head2 L<Catalyst::Log> - Log class.
4014
4015 =head2 L<Catalyst::Request> - Request object
4016
4017 =head2 L<Catalyst::Response> - Response object
4018
4019 =head2 L<Catalyst::Test> - The test suite.
4020
4021 =head1 PROJECT FOUNDER
4022
4023 sri: Sebastian Riedel <sri@cpan.org>
4024
4025 =head1 CONTRIBUTORS
4026
4027 abw: Andy Wardley
4028
4029 acme: Leon Brocard <leon@astray.com>
4030
4031 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
4032
4033 Andrew Bramble
4034
4035 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
4036
4037 Andrew Ruthven
4038
4039 andyg: Andy Grundman <andy@hybridized.org>
4040
4041 audreyt: Audrey Tang
4042
4043 bricas: Brian Cassidy <bricas@cpan.org>
4044
4045 Caelum: Rafael Kitover <rkitover@io.com>
4046
4047 chansen: Christian Hansen
4048
4049 chicks: Christopher Hicks
4050
4051 Chisel Wright C<pause@herlpacker.co.uk>
4052
4053 Danijel Milicevic C<me@danijel.de>
4054
4055 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
4056
4057 David Naughton, C<naughton@umn.edu>
4058
4059 David E. Wheeler
4060
4061 dhoss: Devin Austin <dhoss@cpan.org>
4062
4063 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
4064
4065 Drew Taylor
4066
4067 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
4068
4069 esskar: Sascha Kiefer
4070
4071 fireartist: Carl Franks <cfranks@cpan.org>
4072
4073 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
4074
4075 gabb: Danijel Milicevic
4076
4077 Gary Ashton Jones
4078
4079 Gavin Henry C<ghenry@perl.me.uk>
4080
4081 Geoff Richards
4082
4083 groditi: Guillermo Roditi <groditi@gmail.com>
4084
4085 hobbs: Andrew Rodland <andrew@cleverdomain.org>
4086
4087 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
4088
4089 jcamacho: Juan Camacho
4090
4091 jester: Jesse Sheidlower C<jester@panix.com>
4092
4093 jhannah: Jay Hannah <jay@jays.net>
4094
4095 Jody Belka
4096
4097 Johan Lindstrom
4098
4099 jon: Jon Schutz <jjschutz@cpan.org>
4100
4101 Jonathan Rockway C<< <jrockway@cpan.org> >>
4102
4103 Kieren Diment C<kd@totaldatasolution.com>
4104
4105 konobi: Scott McWhirter <konobi@cpan.org>
4106
4107 marcus: Marcus Ramberg <mramberg@cpan.org>
4108
4109 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
4110
4111 mgrimes: Mark Grimes <mgrimes@cpan.org>
4112
4113 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
4114
4115 mugwump: Sam Vilain
4116
4117 naughton: David Naughton
4118
4119 ningu: David Kamholz <dkamholz@cpan.org>
4120
4121 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
4122
4123 numa: Dan Sully <daniel@cpan.org>
4124
4125 obra: Jesse Vincent
4126
4127 Octavian Rasnita
4128
4129 omega: Andreas Marienborg
4130
4131 Oleg Kostyuk <cub.uanic@gmail.com>
4132
4133 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
4134
4135 rafl: Florian Ragwitz <rafl@debian.org>
4136
4137 random: Roland Lammel <lammel@cpan.org>
4138
4139 Robert Sedlacek C<< <rs@474.at> >>
4140
4141 SpiceMan: Marcel Montes
4142
4143 sky: Arthur Bergman
4144
4145 szbalint: Balint Szilakszi <szbalint@cpan.org>
4146
4147 t0m: Tomas Doran <bobtfish@bobtfish.net>
4148
4149 Ulf Edvinsson
4150
4151 vanstyn: Henry Van Styn <vanstyn@cpan.org>
4152
4153 Viljo Marrandi C<vilts@yahoo.com>
4154
4155 Will Hawes C<info@whawes.co.uk>
4156
4157 willert: Sebastian Willert <willert@cpan.org>
4158
4159 wreis: Wallace Reis <wreis@cpan.org>
4160
4161 Yuval Kogman, C<nothingmuch@woobling.org>
4162
4163 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
4164
4165 dd070: Dhaval Dhanani <dhaval070@gmail.com>
4166
4167 Upasana <me@upasana.me>
4168
4169 =head1 COPYRIGHT
4170
4171 Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
4172
4173 =head1 LICENSE
4174
4175 This library is free software. You can redistribute it and/or modify it under
4176 the same terms as Perl itself.
4177
4178 =cut
4179
4180 no Moose;
4181
4182 __PACKAGE__->meta->make_immutable;
4183
4184 1;