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.90069_003';
 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     if ( ref $value eq 'ARRAY' ) {
3075         foreach ( @$value ) {
3076             $_ = $self->_handle_unicode_decoding($_);
3077         }
3078         return $value;
3079     }
3080     elsif ( ref $value eq 'HASH' ) {
3081         foreach ( values %$value ) {
3082             $_ = $self->_handle_unicode_decoding($_);
3083         }
3084         return $value;
3085     }
3086     else {
3087         return $self->_handle_param_unicode_decoding($value);
3088     }
3089 }
3090
3091 sub _handle_param_unicode_decoding {
3092     my ( $self, $value ) = @_;
3093     my $enc = $self->encoding;
3094     return try {
3095         Encode::is_utf8( $value ) ?
3096             $value
3097         : $enc->decode( $value, $self->_encode_check );
3098     }
3099     catch {
3100         $self->handle_unicode_encoding_exception({
3101             param_value => $value,
3102             error_msg => $_,
3103             encoding_step => 'params',
3104         });
3105     };
3106 }
3107
3108 =head2 $c->setup_log
3109
3110 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
3111 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
3112 log to.
3113
3114 This method also installs a C<debug> method that returns a true value into the
3115 catalyst subclass if the "debug" level is passed in the comma-delimited list,
3116 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
3117
3118 Note that if the log has already been setup, by either a previous call to
3119 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
3120 that this method won't actually set up the log object.
3121
3122 =cut
3123
3124 sub setup_log {
3125     my ( $class, $levels ) = @_;
3126
3127     $levels ||= '';
3128     $levels =~ s/^\s+//;
3129     $levels =~ s/\s+$//;
3130     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
3131
3132     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
3133     if ( defined $env_debug ) {
3134         $levels{debug} = 1 if $env_debug; # Ugly!
3135         delete($levels{debug}) unless $env_debug;
3136     }
3137
3138     unless ( $class->log ) {
3139         $class->log( Catalyst::Log->new(keys %levels) );
3140     }
3141
3142     if ( $levels{debug} ) {
3143         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
3144         $class->log->debug('Debug messages enabled');
3145     }
3146 }
3147
3148 =head2 $c->setup_plugins
3149
3150 Sets up plugins.
3151
3152 =cut
3153
3154 =head2 $c->setup_stats
3155
3156 Sets up timing statistics class.
3157
3158 =cut
3159
3160 sub setup_stats {
3161     my ( $class, $stats ) = @_;
3162
3163     Catalyst::Utils::ensure_class_loaded($class->stats_class);
3164
3165     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
3166     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
3167         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
3168         $class->log->debug('Statistics enabled');
3169     }
3170 }
3171
3172
3173 =head2 $c->registered_plugins
3174
3175 Returns a sorted list of the plugins which have either been stated in the
3176 import list.
3177
3178 If passed a given plugin name, it will report a boolean value indicating
3179 whether or not that plugin is loaded.  A fully qualified name is required if
3180 the plugin name does not begin with C<Catalyst::Plugin::>.
3181
3182  if ($c->registered_plugins('Some::Plugin')) {
3183      ...
3184  }
3185
3186 =cut
3187
3188 {
3189
3190     sub registered_plugins {
3191         my $proto = shift;
3192         return sort keys %{ $proto->_plugins } unless @_;
3193         my $plugin = shift;
3194         return 1 if exists $proto->_plugins->{$plugin};
3195         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
3196     }
3197
3198     sub _register_plugin {
3199         my ( $proto, $plugin, $instant ) = @_;
3200         my $class = ref $proto || $proto;
3201
3202         load_class( $plugin );
3203         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
3204             if $plugin->isa( 'Catalyst::Component' );
3205         my $plugin_meta = Moose::Meta::Class->create($plugin);
3206         if (!$plugin_meta->has_method('new')
3207             && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
3208             $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
3209         }
3210         if (!$instant && !$proto->_plugins->{$plugin}) {
3211             my $meta = Class::MOP::get_metaclass_by_name($class);
3212             $meta->superclasses($plugin, $meta->superclasses);
3213         }
3214         $proto->_plugins->{$plugin} = 1;
3215         return $class;
3216     }
3217
3218     sub _default_plugins { return qw() }
3219
3220     sub setup_plugins {
3221         my ( $class, $plugins ) = @_;
3222
3223         $class->_plugins( {} ) unless $class->_plugins;
3224         $plugins = [ grep {
3225             m/Unicode::Encoding/ ? do {
3226                 $class->log->warn(
3227                     'Unicode::Encoding plugin is auto-applied,'
3228                     . ' please remove this from your appclass'
3229                     . ' and make sure to define "encoding" config'
3230                 );
3231                 unless (exists $class->config->{'encoding'}) {
3232                   $class->config->{'encoding'} = 'UTF-8';
3233                 }
3234                 () }
3235                 : $_
3236         } @$plugins ];
3237         push @$plugins, $class->_default_plugins;
3238         $plugins = Data::OptList::mkopt($plugins || []);
3239
3240         my @plugins = map {
3241             [ Catalyst::Utils::resolve_namespace(
3242                   $class . '::Plugin',
3243                   'Catalyst::Plugin', $_->[0]
3244               ),
3245               $_->[1],
3246             ]
3247          } @{ $plugins };
3248
3249         for my $plugin ( reverse @plugins ) {
3250             load_class($plugin->[0], $plugin->[1]);
3251             my $meta = find_meta($plugin->[0]);
3252             next if $meta && $meta->isa('Moose::Meta::Role');
3253
3254             $class->_register_plugin($plugin->[0]);
3255         }
3256
3257         my @roles =
3258             map  { $_->[0]->name, $_->[1] }
3259             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
3260             map  { [find_meta($_->[0]), $_->[1]] }
3261             @plugins;
3262
3263         Moose::Util::apply_all_roles(
3264             $class => @roles
3265         ) if @roles;
3266     }
3267 }
3268
3269 =head2 registered_middlewares
3270
3271 Read only accessor that returns an array of all the middleware in the order
3272 that they were added (which is the REVERSE of the order they will be applied).
3273
3274 The values returned will be either instances of L<Plack::Middleware> or of a
3275 compatible interface, or a coderef, which is assumed to be inlined middleware
3276
3277 =head2 setup_middleware (?@middleware)
3278
3279 Read configuration information stored in configuration key C<psgi_middleware> or
3280 from passed @args.
3281
3282 See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
3283 to use it to enable L<Plack::Middleware>
3284
3285 This method is automatically called during 'setup' of your application, so
3286 you really don't need to invoke it.  However you may do so if you find the idea
3287 of loading middleware via configuration weird :).  For example:
3288
3289     package MyApp;
3290
3291     use Catalyst;
3292
3293     __PACKAGE__->setup_middleware('Head');
3294     __PACKAGE__->setup;
3295
3296 When we read middleware definitions from configuration, we reverse the list
3297 which sounds odd but is likely how you expect it to work if you have prior
3298 experience with L<Plack::Builder> or if you previously used the plugin
3299 L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
3300
3301 So basically your middleware handles an incoming request from the first
3302 registered middleware, down and handles the response from the last middleware
3303 up.
3304
3305 =cut
3306
3307 sub registered_middlewares {
3308     my $class = shift;
3309     if(my $middleware = $class->_psgi_middleware) {
3310         return (
3311           Catalyst::Middleware::Stash->new,
3312           Plack::Middleware::HTTPExceptions->new,
3313           Plack::Middleware::RemoveRedundantBody->new,
3314           Plack::Middleware::FixMissingBodyInRedirect->new,
3315           Plack::Middleware::ContentLength->new,
3316           Plack::Middleware::MethodOverride->new,
3317           Plack::Middleware::Head->new,
3318           @$middleware);
3319     } else {
3320         die "You cannot call ->registered_middlewares until middleware has been setup";
3321     }
3322 }
3323
3324 sub setup_middleware {
3325     my $class = shift;
3326     my @middleware_definitions = @_ ?
3327       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
3328
3329     my @middleware = ();
3330     while(my $next = shift(@middleware_definitions)) {
3331         if(ref $next) {
3332             if(Scalar::Util::blessed $next && $next->can('wrap')) {
3333                 push @middleware, $next;
3334             } elsif(ref $next eq 'CODE') {
3335                 push @middleware, $next;
3336             } elsif(ref $next eq 'HASH') {
3337                 my $namespace = shift @middleware_definitions;
3338                 my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
3339                 push @middleware, $mw;
3340             } else {
3341               die "I can't handle middleware definition ${\ref $next}";
3342             }
3343         } else {
3344           my $mw = $class->Catalyst::Utils::build_middleware($next);
3345           push @middleware, $mw;
3346         }
3347     }
3348
3349     my @existing = @{$class->_psgi_middleware || []};
3350     $class->_psgi_middleware([@middleware,@existing,]);
3351 }
3352
3353 =head2 registered_data_handlers
3354
3355 A read only copy of registered Data Handlers returned as a Hash, where each key
3356 is a content type and each value is a subref that attempts to decode that content
3357 type.
3358
3359 =head2 setup_data_handlers (?@data_handler)
3360
3361 Read configuration information stored in configuration key C<data_handlers> or
3362 from passed @args.
3363
3364 See under L</CONFIGURATION> information regarding C<data_handlers>.
3365
3366 This method is automatically called during 'setup' of your application, so
3367 you really don't need to invoke it.
3368
3369 =head2 default_data_handlers
3370
3371 Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
3372 only two default data handlers, for 'application/json' and an alternative to
3373 'application/x-www-form-urlencoded' which supposed nested form parameters via
3374 L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
3375
3376 The 'application/json' data handler is used to parse incoming JSON into a Perl
3377 data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
3378 is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
3379 JSON decoder, and has the smallest dependency impact.
3380
3381 Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
3382 use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
3383 order to get the best performance.  You should add either to your dependency
3384 list (Makefile.PL, dist.ini, cpanfile, etc.)
3385
3386 =cut
3387
3388 sub registered_data_handlers {
3389     my $class = shift;
3390     if(my $data_handlers = $class->_data_handlers) {
3391         return %$data_handlers;
3392     } else {
3393         $class->setup_data_handlers;
3394         return $class->registered_data_handlers;
3395     }
3396 }
3397
3398 sub setup_data_handlers {
3399     my ($class, %data_handler_callbacks) = @_;
3400     %data_handler_callbacks = (
3401       %{$class->default_data_handlers},
3402       %{$class->config->{'data_handlers'}||+{}},
3403       %data_handler_callbacks);
3404
3405     $class->_data_handlers(\%data_handler_callbacks);
3406 }
3407
3408 sub default_data_handlers {
3409     my ($class) = @_;
3410     return +{
3411       'application/x-www-form-urlencoded' => sub {
3412           my ($fh, $req) = @_;
3413           my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
3414           Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
3415             ->can('build_cgi_struct')->($params);
3416       },
3417       'application/json' => sub {
3418           Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
3419             ->can('decode_json')->(do { local $/; $_->getline });
3420       },
3421     };
3422 }
3423
3424 =head2 $c->stack
3425
3426 Returns an arrayref of the internal execution stack (actions that are
3427 currently executing).
3428
3429 =head2 $c->stats
3430
3431 Returns the current timing statistics object. By default Catalyst uses
3432 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
3433 L<< stats_class|/"$c->stats_class" >>.
3434
3435 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
3436 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
3437 profile explicitly, although MyApp.pm still won't profile nor output anything
3438 by itself.
3439
3440 =head2 $c->stats_class
3441
3442 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
3443
3444 =head2 $c->use_stats
3445
3446 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
3447
3448 Note that this is a static method, not an accessor and should be overridden
3449 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
3450
3451 =cut
3452
3453 sub use_stats { 0 }
3454
3455
3456 =head2 $c->write( $data )
3457
3458 Writes $data to the output stream. When using this method directly, you
3459 will need to manually set the C<Content-Length> header to the length of
3460 your output data, if known.
3461
3462 =cut
3463
3464 sub write {
3465     my $c = shift;
3466
3467     # Finalize headers if someone manually writes output (for compat)
3468     $c->finalize_headers;
3469
3470     return $c->response->write( @_ );
3471 }
3472
3473 =head2 version
3474
3475 Returns the Catalyst version number. Mostly useful for "powered by"
3476 messages in template systems.
3477
3478 =cut
3479
3480 sub version { return $Catalyst::VERSION }
3481
3482 =head1 CONFIGURATION
3483
3484 There are a number of 'base' config variables which can be set:
3485
3486 =over
3487
3488 =item *
3489
3490 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
3491
3492 =item *
3493
3494 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
3495
3496 =item *
3497
3498 C<disable_component_resolution_regex_fallback> - Turns
3499 off the deprecated component resolution functionality so
3500 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
3501 are called then regex search will not be attempted on string values and
3502 instead C<undef> will be returned.
3503
3504 =item *
3505
3506 C<home> - The application home directory. In an uninstalled application,
3507 this is the top level application directory. In an installed application,
3508 this will be the directory containing C<< MyApp.pm >>.
3509
3510 =item *
3511
3512 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3513
3514 =item *
3515
3516 C<name> - The name of the application in debug messages and the debug and
3517 welcome screens
3518
3519 =item *
3520
3521 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3522 until it is accessed. This allows you to (for example) check authentication (and reject
3523 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
3524
3525 =item *
3526
3527 C<root> - The root directory for templates. Usually this is just a
3528 subdirectory of the home directory, but you can set it to change the
3529 templates to a different directory.
3530
3531 =item *
3532
3533 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3534 namespaces from which components will be loaded (and constructed and stored in
3535 C<< $c->components >>).
3536
3537 =item *
3538
3539 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3540 to be shown in hit debug tables in the test server.
3541
3542 =item *
3543
3544 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
3545 variable should be used for determining the request path.
3546
3547 Most web server environments pass the requested path to the application using environment variables,
3548 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
3549 exposed as C<< $c->request->base >>) and the request path below that base.
3550
3551 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
3552 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
3553
3554 =over
3555
3556 =item use_request_uri_for_path => 0
3557
3558 This is the default (and the) traditional method that Catalyst has used for determining the path information.
3559 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
3560 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
3561 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
3562
3563 However this method has the major disadvantage that it is impossible to correctly decode some elements
3564 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
3565 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
3566 can't distinguish / vs %2F in paths (in addition to other encoded values).
3567
3568 =item use_request_uri_for_path => 1
3569
3570 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
3571 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
3572 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
3573
3574 Given that this method of path resolution is provably more correct, it is recommended that you use
3575 this unless you have a specific need to deploy your application in a non-standard environment, and you are
3576 aware of the implications of not being able to handle encoded URI paths correctly.
3577
3578 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
3579 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
3580 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
3581 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
3582 C<< $c->request->base >> will be incorrect.
3583
3584 =back
3585
3586 =item *
3587
3588 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3589
3590 =item *
3591
3592 C<encoding> - See L</ENCODING>
3593
3594 =item *
3595
3596 C<abort_chain_on_error_fix>
3597
3598 When there is an error in an action chain, the default behavior is to continue
3599 processing the remaining actions and then catch the error upon chain end.  This
3600 can lead to running actions when the application is in an unexpected state.  If
3601 you have this issue, setting this config value to true will promptly exit a
3602 chain when there is an error raised in any action (thus terminating the chain
3603 early.)
3604
3605 use like:
3606
3607     __PACKAGE__->config(abort_chain_on_error_fix => 1);
3608
3609 In the future this might become the default behavior.
3610
3611 =item *
3612
3613 C<use_hash_multivalue_in_request>
3614
3615 In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
3616 and C<parameters> return a hashref where values might be scalar or an arrayref
3617 depending on the incoming data.  In many cases this can be undesirable as it
3618 leads one to writing defensive code like the following:
3619
3620     my ($val) = ref($c->req->parameters->{a}) ?
3621       @{$c->req->parameters->{a}} :
3622         $c->req->parameters->{a};
3623
3624 Setting this configuration item to true will make L<Catalyst> populate the
3625 attributes underlying these methods with an instance of L<Hash::MultiValue>
3626 which is used by L<Plack::Request> and others to solve this very issue.  You
3627 may prefer this behavior to the default, if so enable this option (be warned
3628 if you enable it in a legacy application we are not sure if it is completely
3629 backwardly compatible).
3630
3631 =item *
3632
3633 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
3634
3635 =item *
3636
3637 C<data_handlers> - See L<DATA HANDLERS>.
3638
3639 =back
3640
3641 =head1 EXCEPTIONS
3642
3643 Generally when you throw an exception inside an Action (or somewhere in
3644 your stack, such as in a model that an Action is calling) that exception
3645 is caught by Catalyst and unless you either catch it yourself (via eval
3646 or something like L<Try::Tiny> or by reviewing the L</error> stack, it
3647 will eventually reach L</finalize_errors> and return either the debugging
3648 error stack page, or the default error page.  However, if your exception
3649 can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
3650 instead rethrow it so that it can be handled by that middleware (which
3651 is part of the default middleware).  For example this would allow
3652
3653     use HTTP::Throwable::Factory 'http_throw';
3654
3655     sub throws_exception :Local {
3656       my ($self, $c) = @_;
3657
3658       http_throw(SeeOther => { location =>
3659         $c->uri_for($self->action_for('redirect')) });
3660
3661     }
3662
3663 =head1 INTERNAL ACTIONS
3664
3665 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3666 C<_ACTION>, and C<_END>. These are by default not shown in the private
3667 action table, but you can make them visible with a config parameter.
3668
3669     MyApp->config(show_internal_actions => 1);
3670
3671 =head1 ON-DEMAND PARSER
3672
3673 The request body is usually parsed at the beginning of a request,
3674 but if you want to handle input yourself, you can enable on-demand
3675 parsing with a config parameter.
3676
3677     MyApp->config(parse_on_demand => 1);
3678
3679 =head1 PROXY SUPPORT
3680
3681 Many production servers operate using the common double-server approach,
3682 with a lightweight frontend web server passing requests to a larger
3683 backend server. An application running on the backend server must deal
3684 with two problems: the remote user always appears to be C<127.0.0.1> and
3685 the server's hostname will appear to be C<localhost> regardless of the
3686 virtual host that the user connected through.
3687
3688 Catalyst will automatically detect this situation when you are running
3689 the frontend and backend servers on the same machine. The following
3690 changes are made to the request.
3691
3692     $c->req->address is set to the user's real IP address, as read from
3693     the HTTP X-Forwarded-For header.
3694
3695     The host value for $c->req->base and $c->req->uri is set to the real
3696     host, as read from the HTTP X-Forwarded-Host header.
3697
3698 Additionally, you may be running your backend application on an insecure
3699 connection (port 80) while your frontend proxy is running under SSL.  If there
3700 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3701 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3702 be created properly.
3703
3704 In the case of passing in:
3705
3706     X-Forwarded-Port: 443
3707
3708 All calls to C<uri_for> will result in an https link, as is expected.
3709
3710 Obviously, your web server must support these headers for this to work.
3711
3712 In a more complex server farm environment where you may have your
3713 frontend proxy server(s) on different machines, you will need to set a
3714 configuration option to tell Catalyst to read the proxied data from the
3715 headers.
3716
3717     MyApp->config(using_frontend_proxy => 1);
3718
3719 If you do not wish to use the proxy support at all, you may set:
3720
3721     MyApp->config(ignore_frontend_proxy => 0);
3722
3723 =head2 Note about psgi files
3724
3725 Note that if you supply your own .psgi file, calling
3726 C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>.
3727
3728 You either need to apply L<Plack::Middleware::ReverseProxy> yourself
3729 in your psgi, for example:
3730
3731     builder {
3732         enable "Plack::Middleware::ReverseProxy";
3733         MyApp->psgi_app
3734     };
3735
3736 This will unconditionally add the ReverseProxy support, or you need to call
3737 C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
3738 apply the support depending upon your config).
3739
3740 See L<Catalyst::PSGI> for more information.
3741
3742 =head1 THREAD SAFETY
3743
3744 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3745 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3746 believe the Catalyst core to be thread-safe.
3747
3748 If you plan to operate in a threaded environment, remember that all other
3749 modules you are using must also be thread-safe. Some modules, most notably
3750 L<DBD::SQLite>, are not thread-safe.
3751
3752 =head1 DATA HANDLERS
3753
3754 The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
3755 form parameters and URL search query fields.  However it has become common
3756 for various alternative content types to be PUT or POSTed to your controllers
3757 and actions.  People working on RESTful APIs, or using AJAX often use JSON,
3758 XML and other content types when communicating with an application server.  In
3759 order to better support this use case, L<Catalyst> defines a global configuration
3760 option, C<data_handlers>, which lets you associate a content type with a coderef
3761 that parses that content type into something Perl can readily access.
3762
3763     package MyApp::Web;
3764
3765     use Catalyst;
3766     use JSON::Maybe;
3767
3768     __PACKAGE__->config(
3769       data_handlers => {
3770         'application/json' => sub { local $/; decode_json $_->getline },
3771       },
3772       ## Any other configuration.
3773     );
3774
3775     __PACKAGE__->setup;
3776
3777 By default L<Catalyst> comes with a generic JSON data handler similar to the
3778 example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
3779 (a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
3780 it installed (if you want the faster XS parser, add it to you project Makefile.PL
3781 or dist.ini, cpanfile, etc.)
3782
3783 The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types
3784 (matched against the incoming request type using a regexp such as to be case
3785 insensitive) and whose values are coderefs that receive a localized version of
3786 C<$_> which is a filehandle object pointing to received body.
3787
3788 This feature is considered an early access release and we reserve the right
3789 to alter the interface in order to provide a performant and secure solution to
3790 alternative request body content.  Your reports welcomed!
3791
3792 =head1 PSGI MIDDLEWARE
3793
3794 You can define middleware, defined as L<Plack::Middleware> or a compatible
3795 interface in configuration.  Your middleware definitions are in the form of an
3796 arrayref under the configuration key C<psgi_middleware>.  Here's an example
3797 with details to follow:
3798
3799     package MyApp::Web;
3800
3801     use Catalyst;
3802     use Plack::Middleware::StackTrace;
3803
3804     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3805
3806     __PACKAGE__->config(
3807       'psgi_middleware', [
3808         'Debug',
3809         '+MyApp::Custom',
3810         $stacktrace_middleware,
3811         'Session' => {store => 'File'},
3812         sub {
3813           my $app = shift;
3814           return sub {
3815             my $env = shift;
3816             $env->{myapp.customkey} = 'helloworld';
3817             $app->($env);
3818           },
3819         },
3820       ],
3821     );
3822
3823     __PACKAGE__->setup;
3824
3825 So the general form is:
3826
3827     __PACKAGE__->config(psgi_middleware => \@middleware_definitions);
3828
3829 Where C<@middleware> is one or more of the following, applied in the REVERSE of
3830 the order listed (to make it function similarly to L<Plack::Builder>:
3831
3832 Alternatively, you may also define middleware by calling the L</setup_middleware>
3833 package method:
3834
3835     package MyApp::Web;
3836
3837     use Catalyst;
3838
3839     __PACKAGE__->setup_middleware( \@middleware_definitions);
3840     __PACKAGE__->setup;
3841
3842 In the case where you do both (use 'setup_middleware' and configuration) the
3843 package call to setup_middleware will be applied earlier (in other words its
3844 middleware will wrap closer to the application).  Keep this in mind since in
3845 some cases the order of middleware is important.
3846
3847 The two approaches are not exclusive.
3848
3849 =over 4
3850
3851 =item Middleware Object
3852
3853 An already initialized object that conforms to the L<Plack::Middleware>
3854 specification:
3855
3856     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3857
3858     __PACKAGE__->config(
3859       'psgi_middleware', [
3860         $stacktrace_middleware,
3861       ]);
3862
3863
3864 =item coderef
3865
3866 A coderef that is an inlined middleware:
3867
3868     __PACKAGE__->config(
3869       'psgi_middleware', [
3870         sub {
3871           my $app = shift;
3872           return sub {
3873             my $env = shift;
3874             if($env->{PATH_INFO} =~m/forced/) {
3875               Plack::App::File
3876                 ->new(file=>TestApp->path_to(qw/share static forced.txt/))
3877                 ->call($env);
3878             } else {
3879               return $app->($env);
3880             }
3881          },
3882       },
3883     ]);
3884
3885
3886
3887 =item a scalar
3888
3889 We assume the scalar refers to a namespace after normalizing it using the
3890 following rules:
3891
3892 (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string
3893 is assumed to be 'as is', and we just install and use the middleware.
3894
3895 (2) If the scalar begins with "Plack::Middleware" or your application namespace
3896 (the package name of your Catalyst application subclass), we also assume then
3897 that it is a full namespace, and use it.
3898
3899 (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to
3900 resolve it first by looking for it under your application namespace (for example
3901 if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look
3902 under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we
3903 will then look under the regular L<Plack::Middleware> namespace (i.e. for the
3904 previous we'd try "Plack::Middleware::MyMiddleware").  We look under your application
3905 namespace first to let you 'override' common L<Plack::Middleware> locally, should
3906 you find that a good idea.
3907
3908 Examples:
3909
3910     package MyApp::Web;
3911
3912     __PACKAGE__->config(
3913       'psgi_middleware', [
3914         'Debug',  ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap
3915         'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap
3916         '+MyApp::Custom',  ## MyApp::Custom->wrap
3917       ],
3918     );
3919
3920 =item a scalar followed by a hashref
3921
3922 Just like the previous, except the following C<HashRef> is used as arguments
3923 to initialize the middleware object.
3924
3925     __PACKAGE__->config(
3926       'psgi_middleware', [
3927          'Session' => {store => 'File'},
3928     ]);
3929
3930 =back
3931
3932 Please see L<PSGI> for more on middleware.
3933
3934 =head1 ENCODING
3935
3936 On request, decodes all params from encoding into a sequence of
3937 logical characters. On response, encodes body into encoding.
3938
3939 =head2 Methods
3940
3941 =over 4
3942
3943 =item encoding
3944
3945 Returns an instance of an C<Encode> encoding
3946
3947     print $c->encoding->name
3948
3949 =item handle_unicode_encoding_exception ($exception_context)
3950
3951 Method called when decoding process for a request fails.
3952
3953 An C<$exception_context> hashref is provided to allow you to override the
3954 behaviour of your application when given data with incorrect encodings.
3955
3956 The default method throws exceptions in the case of invalid request parameters
3957 (resulting in a 500 error), but ignores errors in upload filenames.
3958
3959 The keys passed in the C<$exception_context> hash are:
3960
3961 =over
3962
3963 =item param_value
3964
3965 The value which was not able to be decoded.
3966
3967 =item error_msg
3968
3969 The exception received from L<Encode>.
3970
3971 =item encoding_step
3972
3973 What type of data was being decoded. Valid values are (currently)
3974 C<params> - for request parameters / arguments / captures
3975 and C<uploads> - for request upload filenames.
3976
3977 =back
3978
3979 =back
3980
3981 =head1 SUPPORT
3982
3983 IRC:
3984
3985     Join #catalyst on irc.perl.org.
3986
3987 Mailing Lists:
3988
3989     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
3990     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
3991
3992 Web:
3993
3994     http://catalyst.perl.org
3995
3996 Wiki:
3997
3998     http://dev.catalyst.perl.org
3999
4000 =head1 SEE ALSO
4001
4002 =head2 L<Task::Catalyst> - All you need to start with Catalyst
4003
4004 =head2 L<Catalyst::Manual> - The Catalyst Manual
4005
4006 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
4007
4008 =head2 L<Catalyst::Engine> - Core engine
4009
4010 =head2 L<Catalyst::Log> - Log class.
4011
4012 =head2 L<Catalyst::Request> - Request object
4013
4014 =head2 L<Catalyst::Response> - Response object
4015
4016 =head2 L<Catalyst::Test> - The test suite.
4017
4018 =head1 PROJECT FOUNDER
4019
4020 sri: Sebastian Riedel <sri@cpan.org>
4021
4022 =head1 CONTRIBUTORS
4023
4024 abw: Andy Wardley
4025
4026 acme: Leon Brocard <leon@astray.com>
4027
4028 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
4029
4030 Andrew Bramble
4031
4032 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
4033
4034 Andrew Ruthven
4035
4036 andyg: Andy Grundman <andy@hybridized.org>
4037
4038 audreyt: Audrey Tang
4039
4040 bricas: Brian Cassidy <bricas@cpan.org>
4041
4042 Caelum: Rafael Kitover <rkitover@io.com>
4043
4044 chansen: Christian Hansen
4045
4046 chicks: Christopher Hicks
4047
4048 Chisel Wright C<pause@herlpacker.co.uk>
4049
4050 Danijel Milicevic C<me@danijel.de>
4051
4052 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
4053
4054 David Naughton, C<naughton@umn.edu>
4055
4056 David E. Wheeler
4057
4058 dhoss: Devin Austin <dhoss@cpan.org>
4059
4060 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
4061
4062 Drew Taylor
4063
4064 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
4065
4066 esskar: Sascha Kiefer
4067
4068 fireartist: Carl Franks <cfranks@cpan.org>
4069
4070 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
4071
4072 gabb: Danijel Milicevic
4073
4074 Gary Ashton Jones
4075
4076 Gavin Henry C<ghenry@perl.me.uk>
4077
4078 Geoff Richards
4079
4080 groditi: Guillermo Roditi <groditi@gmail.com>
4081
4082 hobbs: Andrew Rodland <andrew@cleverdomain.org>
4083
4084 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
4085
4086 jcamacho: Juan Camacho
4087
4088 jester: Jesse Sheidlower C<jester@panix.com>
4089
4090 jhannah: Jay Hannah <jay@jays.net>
4091
4092 Jody Belka
4093
4094 Johan Lindstrom
4095
4096 jon: Jon Schutz <jjschutz@cpan.org>
4097
4098 Jonathan Rockway C<< <jrockway@cpan.org> >>
4099
4100 Kieren Diment C<kd@totaldatasolution.com>
4101
4102 konobi: Scott McWhirter <konobi@cpan.org>
4103
4104 marcus: Marcus Ramberg <mramberg@cpan.org>
4105
4106 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
4107
4108 mgrimes: Mark Grimes <mgrimes@cpan.org>
4109
4110 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
4111
4112 mugwump: Sam Vilain
4113
4114 naughton: David Naughton
4115
4116 ningu: David Kamholz <dkamholz@cpan.org>
4117
4118 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
4119
4120 numa: Dan Sully <daniel@cpan.org>
4121
4122 obra: Jesse Vincent
4123
4124 Octavian Rasnita
4125
4126 omega: Andreas Marienborg
4127
4128 Oleg Kostyuk <cub.uanic@gmail.com>
4129
4130 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
4131
4132 rafl: Florian Ragwitz <rafl@debian.org>
4133
4134 random: Roland Lammel <lammel@cpan.org>
4135
4136 Robert Sedlacek C<< <rs@474.at> >>
4137
4138 SpiceMan: Marcel Montes
4139
4140 sky: Arthur Bergman
4141
4142 szbalint: Balint Szilakszi <szbalint@cpan.org>
4143
4144 t0m: Tomas Doran <bobtfish@bobtfish.net>
4145
4146 Ulf Edvinsson
4147
4148 vanstyn: Henry Van Styn <vanstyn@cpan.org>
4149
4150 Viljo Marrandi C<vilts@yahoo.com>
4151
4152 Will Hawes C<info@whawes.co.uk>
4153
4154 willert: Sebastian Willert <willert@cpan.org>
4155
4156 wreis: Wallace Reis <wreis@cpan.org>
4157
4158 Yuval Kogman, C<nothingmuch@woobling.org>
4159
4160 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
4161
4162 dd070: Dhaval Dhanani <dhaval070@gmail.com>
4163
4164 Upasana <me@upasana.me>
4165
4166 =head1 COPYRIGHT
4167
4168 Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
4169
4170 =head1 LICENSE
4171
4172 This library is free software. You can redistribute it and/or modify it under
4173 the same terms as Perl itself.
4174
4175 =cut
4176
4177 no Moose;
4178
4179 __PACKAGE__->meta->make_immutable;
4180
4181 1;