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