lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 use Moose::Meta::Class ();
   5 extends 'Catalyst::Component';
   6 use Moose::Util qw/find_meta/;
   7 use namespace::clean -except => 'meta';
   8 use Catalyst::Exception;
   9 use Catalyst::Exception::Detach;
  10 use Catalyst::Exception::Go;
  11 use Catalyst::Log;
  12 use Catalyst::Request;
  13 use Catalyst::Request::Upload;
  14 use Catalyst::Response;
  15 use Catalyst::Utils;
  16 use Catalyst::Controller;
  17 use Data::OptList;
  18 use Devel::InnerPackage ();
  19 use Module::Pluggable::Object ();
  20 use Text::SimpleTable ();
  21 use Path::Class::Dir ();
  22 use Path::Class::File ();
  23 use URI ();
  24 use URI::http;
  25 use URI::https;
  26 use HTML::Entities;
  27 use Tree::Simple qw/use_weak_refs/;
  28 use Tree::Simple::Visitor::FindByUID;
  29 use Class::C3::Adopt::NEXT;
  30 use List::MoreUtils qw/uniq/;
  31 use attributes;
  32 use String::RewritePrefix;
  33 use Catalyst::EngineLoader;
  34 use utf8;
  35 use Carp qw/croak carp shortmess/;
  36 use Try::Tiny;
  37 use Safe::Isa;
  38 use Moose::Util 'find_meta';
  39 use Plack::Middleware::Conditional;
  40 use Plack::Middleware::ReverseProxy;
  41 use Plack::Middleware::IIS6ScriptNameFix;
  42 use Plack::Middleware::IIS7KeepAliveFix;
  43 use Plack::Middleware::LighttpdScriptNameFix;
  44 use Plack::Middleware::ContentLength;
  45 use Plack::Middleware::Head;
  46 use Plack::Middleware::HTTPExceptions;
  47 use Plack::Middleware::FixMissingBodyInRedirect;
  48 use Plack::Middleware::MethodOverride;
  49 use Plack::Middleware::RemoveRedundantBody;
  50 use Catalyst::Middleware::Stash;
  51 use Plack::Util;
  52 use Class::Load 'load_class';
  53 use Encode 2.21 ();
  54
  55 BEGIN { require 5.008003; }
  56
  57 has stack => (is => 'ro', default => sub { [] });
  58 has state => (is => 'rw', default => 0);
  59 has stats => (is => 'rw');
  60 has action => (is => 'rw');
  61 has counter => (is => 'rw', default => sub { {} });
  62 has request => (
  63     is => 'rw',
  64     default => sub {
  65         my $self = shift;
  66         $self->request_class->new($self->_build_request_constructor_args);
  67     },
  68     lazy => 1,
  69 );
  70 sub _build_request_constructor_args {
  71     my $self = shift;
  72     my %p = ( _log => $self->log );
  73     $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
  74     $p{data_handlers} = {$self->registered_data_handlers};
  75     $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
  76       if $self->config->{use_hash_multivalue_in_request};
  77     \%p;
  78 }
  79
  80 has response => (
  81     is => 'rw',
  82     default => sub {
  83         my $self = shift;
  84         $self->response_class->new($self->_build_response_constructor_args);
  85     },
  86     lazy => 1,
  87 );
  88 sub _build_response_constructor_args {
  89     my $self = shift;
  90     { _log => $self->log };
  91 }
  92
  93 has namespace => (is => 'rw');
  94
  95 sub depth { scalar @{ shift->stack || [] }; }
  96 sub comp { shift->component(@_) }
  97
  98 sub req {
  99     my $self = shift; return $self->request(@_);
 100 }
 101 sub res {
 102     my $self = shift; return $self->response(@_);
 103 }
 104
 105 # For backwards compatibility
 106 sub finalize_output { shift->finalize_body(@_) };
 107
 108 # For statistics
 109 our $COUNT     = 1;
 110 our $START     = time;
 111 our $RECURSION = 1000;
 112 our $DETACH    = Catalyst::Exception::Detach->new;
 113 our $GO        = Catalyst::Exception::Go->new;
 114
 115 #I imagine that very few of these really need to be class variables. if any.
 116 #maybe we should just make them attributes with a default?
 117 __PACKAGE__->mk_classdata($_)
 118   for qw/components arguments dispatcher engine log dispatcher_class
 119   engine_loader context_class request_class response_class stats_class
 120   setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
 121   _data_handlers _encoding _encode_check/;
 122
 123 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
 124 __PACKAGE__->request_class('Catalyst::Request');
 125 __PACKAGE__->response_class('Catalyst::Response');
 126 __PACKAGE__->stats_class('Catalyst::Stats');
 127 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 128
 129 # Remember to update this in Catalyst::Runtime as well!
 130 our $VERSION = '5.90073';
 131
 132 sub import {
 133     my ( $class, @arguments ) = @_;
 134
 135     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
 136     # callers @ISA.
 137     return unless $class eq 'Catalyst';
 138
 139     my $caller = caller();
 140     return if $caller eq 'main';
 141
 142     my $meta = Moose::Meta::Class->initialize($caller);
 143     unless ( $caller->isa('Catalyst') ) {
 144         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
 145         $meta->superclasses(@superclasses);
 146     }
 147     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
 148     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 149
 150     unless( $meta->has_method('meta') ){
 151         if ($Moose::VERSION >= 1.15) {
 152             $meta->_add_meta_method('meta');
 153         }
 154         else {
 155             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
 156         }
 157     }
 158
 159     $caller->arguments( [@arguments] );
 160     $caller->setup_home;
 161 }
 162
 163 sub _application { $_[0] }
 164
 165 =encoding UTF-8
 166
 167 =head1 NAME
 168
 169 Catalyst - The Elegant MVC Web Application Framework
 170
 171 =head1 SYNOPSIS
 172
 173 See the L<Catalyst::Manual> distribution for comprehensive
 174 documentation and tutorials.
 175
 176     # Install Catalyst::Devel for helpers and other development tools
 177     # use the helper to create a new application
 178     catalyst.pl MyApp
 179
 180     # add models, views, controllers
 181     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 182     script/myapp_create.pl view MyTemplate TT
 183     script/myapp_create.pl controller Search
 184
 185     # built in testserver -- use -r to restart automatically on changes
 186     # --help to see all available options
 187     script/myapp_server.pl
 188
 189     # command line testing interface
 190     script/myapp_test.pl /yada
 191
 192     ### in lib/MyApp.pm
 193     use Catalyst qw/-Debug/; # include plugins here as well
 194
 195     ### In lib/MyApp/Controller/Root.pm (autocreated)
 196     sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
 197         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 198         $c->stash->{template} = 'foo.tt'; # set the template
 199         # lookup something from db -- stash vars are passed to TT
 200         $c->stash->{data} =
 201           $c->model('Database::Foo')->search( { country => $args[0] } );
 202         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 203             $c->forward( 'bar' ); # process another action
 204             # do something else after forward returns
 205         }
 206     }
 207
 208     # The foo.tt TT template can use the stash data from the database
 209     [% WHILE (item = data.next) %]
 210         [% item.foo %]
 211     [% END %]
 212
 213     # called for /bar/of/soap, /bar/of/soap/10, etc.
 214     sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
 215
 216     # called after all actions are finished
 217     sub end : Action {
 218         my ( $self, $c ) = @_;
 219         if ( scalar @{ $c->error } ) { ... } # handle errors
 220         return if $c->res->body; # already have a response
 221         $c->forward( 'MyApp::View::TT' ); # render template
 222     }
 223
 224 See L<Catalyst::Manual::Intro> for additional information.
 225
 226 =head1 DESCRIPTION
 227
 228 Catalyst is a modern framework for making web applications without the
 229 pain usually associated with this process. This document is a reference
 230 to the main Catalyst application. If you are a new user, we suggest you
 231 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 232
 233 See L<Catalyst::Manual> for more documentation.
 234
 235 Catalyst plugins can be loaded by naming them as arguments to the "use
 236 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 237 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 238 C<My::Module>.
 239
 240     use Catalyst qw/My::Module/;
 241
 242 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 243 fully qualify the name by using a unary plus:
 244
 245     use Catalyst qw/
 246         My::Module
 247         +Fully::Qualified::Plugin::Name
 248     /;
 249
 250 Special flags like C<-Debug> can also be specified as
 251 arguments when Catalyst is loaded:
 252
 253     use Catalyst qw/-Debug My::Module/;
 254
 255 The position of plugins and flags in the chain is important, because
 256 they are loaded in the order in which they appear.
 257
 258 The following flags are supported:
 259
 260 =head2 -Debug
 261
 262 Enables debug output. You can also force this setting from the system
 263 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 264 settings override the application, with <MYAPP>_DEBUG having the highest
 265 priority.
 266
 267 This sets the log level to 'debug' and enables full debug output on the
 268 error screen. If you only want the latter, see L<< $c->debug >>.
 269
 270 =head2 -Home
 271
 272 Forces Catalyst to use a specific home directory, e.g.:
 273
 274     use Catalyst qw[-Home=/usr/mst];
 275
 276 This can also be done in the shell environment by setting either the
 277 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 278 is replaced with the uppercased name of your application, any "::" in
 279 the name will be replaced with underscores, e.g. MyApp::Web should use
 280 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 281
 282 If none of these are set, Catalyst will attempt to automatically detect the
 283 home directory. If you are working in a development environment, Catalyst
 284 will try and find the directory containing either Makefile.PL, Build.PL,
 285 dist.ini, or cpanfile. If the application has been installed into the system
 286 (i.e. you have done C<make install>), then Catalyst will use the path to your
 287 application module, without the .pm extension (e.g., /foo/MyApp if your
 288 application was installed at /foo/MyApp.pm)
 289
 290 =head2 -Log
 291
 292     use Catalyst '-Log=warn,fatal,error';
 293
 294 Specifies a comma-delimited list of log levels.
 295
 296 =head2 -Stats
 297
 298 Enables statistics collection and reporting.
 299
 300    use Catalyst qw/-Stats=1/;
 301
 302 You can also force this setting from the system environment with CATALYST_STATS
 303 or <MYAPP>_STATS. The environment settings override the application, with
 304 <MYAPP>_STATS having the highest priority.
 305
 306 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
 307
 308 =head1 METHODS
 309
 310 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 311
 312 =head2 $c->action
 313
 314 Returns a L<Catalyst::Action> object for the current action, which
 315 stringifies to the action name. See L<Catalyst::Action>.
 316
 317 =head2 $c->namespace
 318
 319 Returns the namespace of the current action, i.e., the URI prefix
 320 corresponding to the controller of the current action. For example:
 321
 322     # in Controller::Foo::Bar
 323     $c->namespace; # returns 'foo/bar';
 324
 325 =head2 $c->request
 326
 327 =head2 $c->req
 328
 329 Returns the current L<Catalyst::Request> object, giving access to
 330 information about the current client request (including parameters,
 331 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 332
 333 =head2 REQUEST FLOW HANDLING
 334
 335 =head2 $c->forward( $action [, \@arguments ] )
 336
 337 =head2 $c->forward( $class, $method, [, \@arguments ] )
 338
 339 This is one way of calling another action (method) in the same or
 340 a different controller. You can also use C<< $self->my_method($c, @args) >>
 341 in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
 342 in a different controller.
 343 The main difference is that 'forward' uses some of the Catalyst request
 344 cycle overhead, including debugging, which may be useful to you. On the
 345 other hand, there are some complications to using 'forward', restrictions
 346 on values returned from 'forward', and it may not handle errors as you prefer.
 347 Whether you use 'forward' or not is up to you; it is not considered superior to
 348 the other ways to call a method.
 349
 350 'forward' calls  another action, by its private name. If you give a
 351 class name but no method, C<process()> is called. You may also optionally
 352 pass arguments in an arrayref. The action will receive the arguments in
 353 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 354 C<< $c->req->args >> will be restored to the previous values.
 355
 356 Any data C<return>ed from the action forwarded to, will be returned by the
 357 call to forward.
 358
 359     my $foodata = $c->forward('/foo');
 360     $c->forward('index');
 361     $c->forward(qw/Model::DBIC::Foo do_stuff/);
 362     $c->forward('View::TT');
 363
 364 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 365 an C<< eval { } >> around the call (actually
 366 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
 367 exceptions thrown by the called action non-fatal and pushing them onto
 368 $c->error instead. If you want C<die> to propagate you need to do something
 369 like:
 370
 371     $c->forward('foo');
 372     die join "\n", @{ $c->error } if @{ $c->error };
 373
 374 Or make sure to always return true values from your actions and write
 375 your code like this:
 376
 377     $c->forward('foo') || return;
 378
 379 Another note is that C<< $c->forward >> always returns a scalar because it
 380 actually returns $c->state which operates in a scalar context.
 381 Thus, something like:
 382
 383     return @array;
 384
 385 in an action that is forwarded to is going to return a scalar,
 386 i.e. how many items are in that array, which is probably not what you want.
 387 If you need to return an array then return a reference to it,
 388 or stash it like so:
 389
 390     $c->stash->{array} = \@array;
 391
 392 and access it from the stash.
 393
 394 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
 395
 396 =cut
 397
 398 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
 399
 400 =head2 $c->detach( $action [, \@arguments ] )
 401
 402 =head2 $c->detach( $class, $method, [, \@arguments ] )
 403
 404 =head2 $c->detach()
 405
 406 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
 407 doesn't return to the previous action when processing is finished.
 408
 409 When called with no arguments it escapes the processing chain entirely.
 410
 411 =cut
 412
 413 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 414
 415 =head2 $c->visit( $action [, \@arguments ] )
 416
 417 =head2 $c->visit( $action [, \@captures, \@arguments ] )
 418
 419 =head2 $c->visit( $class, $method, [, \@arguments ] )
 420
 421 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
 422
 423 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
 424 but does a full dispatch, instead of just calling the new C<$action> /
 425 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
 426 you go to are called, just like a new request.
 427
 428 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
 429 This means, for example, that C<< $c->action >> methods such as
 430 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
 431 L<reverse|Catalyst::Action/reverse> return information for the visited action
 432 when they are invoked within the visited action.  This is different from the
 433 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 434 continues to use the $c->action object from the caller action even when
 435 invoked from the called action.
 436
 437 C<< $c->stash >> is kept unchanged.
 438
 439 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
 440 allows you to "wrap" another action, just as it would have been called by
 441 dispatching from a URL, while the analogous
 442 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
 443 transfer control to another action as if it had been reached directly from a URL.
 444
 445 =cut
 446
 447 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 448
 449 =head2 $c->go( $action [, \@arguments ] )
 450
 451 =head2 $c->go( $action [, \@captures, \@arguments ] )
 452
 453 =head2 $c->go( $class, $method, [, \@arguments ] )
 454
 455 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 456
 457 The relationship between C<go> and
 458 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
 459 the relationship between
 460 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
 461 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 462 C<< $c->go >> will perform a full dispatch on the specified action or method,
 463 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 464 C<go> escapes the processing of the current request chain on completion, and
 465 does not return to its caller.
 466
 467 @arguments are arguments to the final destination of $action. @captures are
 468 arguments to the intermediate steps, if any, on the way to the final sub of
 469 $action.
 470
 471 =cut
 472
 473 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 474
 475 =head2 $c->response
 476
 477 =head2 $c->res
 478
 479 Returns the current L<Catalyst::Response> object, see there for details.
 480
 481 =head2 $c->stash
 482
 483 Returns a hashref to the stash, which may be used to store data and pass
 484 it between components during a request. You can also set hash keys by
 485 passing arguments. The stash is automatically sent to the view. The
 486 stash is cleared at the end of a request; it cannot be used for
 487 persistent storage (for this you must use a session; see
 488 L<Catalyst::Plugin::Session> for a complete system integrated with
 489 Catalyst).
 490
 491     $c->stash->{foo} = $bar;
 492     $c->stash( { moose => 'majestic', qux => 0 } );
 493     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 494
 495     # stash is automatically passed to the view for use in a template
 496     $c->forward( 'MyApp::View::TT' );
 497
 498 =cut
 499
 500 sub stash {
 501   my $c = shift;
 502   return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
 503 }
 504
 505 =head2 $c->error
 506
 507 =head2 $c->error($error, ...)
 508
 509 =head2 $c->error($arrayref)
 510
 511 Returns an arrayref containing error messages.  If Catalyst encounters an
 512 error while processing a request, it stores the error in $c->error.  This
 513 method should only be used to store fatal error messages.
 514
 515     my @error = @{ $c->error };
 516
 517 Add a new error.
 518
 519     $c->error('Something bad happened');
 520
 521 =cut
 522
 523 sub error {
 524     my $c = shift;
 525     if ( $_[0] ) {
 526         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 527         croak @$error unless ref $c;
 528         push @{ $c->{error} }, @$error;
 529     }
 530     elsif ( defined $_[0] ) { $c->{error} = undef }
 531     return $c->{error} || [];
 532 }
 533
 534
 535 =head2 $c->state
 536
 537 Contains the return value of the last executed action.
 538 Note that << $c->state >> operates in a scalar context which means that all
 539 values it returns are scalar.
 540
 541 =head2 $c->clear_errors
 542
 543 Clear errors.  You probably don't want to clear the errors unless you are
 544 implementing a custom error screen.
 545
 546 This is equivalent to running
 547
 548     $c->error(0);
 549
 550 =cut
 551
 552 sub clear_errors {
 553     my $c = shift;
 554     $c->error(0);
 555 }
 556
 557 =head2 $c->has_errors
 558
 559 Returns true if you have errors
 560
 561 =cut
 562
 563 sub has_errors { scalar(@{shift->error}) ? 1:0 }
 564
 565 sub _comp_search_prefixes {
 566     my $c = shift;
 567     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
 568 }
 569
 570 # search components given a name and some prefixes
 571 sub _comp_names_search_prefixes {
 572     my ( $c, $name, @prefixes ) = @_;
 573     my $appclass = ref $c || $c;
 574     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 575     $filter = qr/$filter/; # Compile regex now rather than once per loop
 576
 577     # map the original component name to the sub part that we will search against
 578     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 579         grep { /$filter/ } keys %{ $c->components };
 580
 581     # undef for a name will return all
 582     return keys %eligible if !defined $name;
 583
 584     my $query  = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
 585     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 586
 587     return @result if @result;
 588
 589     # if we were given a regexp to search against, we're done.
 590     return if $name->$_isa('Regexp');
 591
 592     # skip regexp fallback if configured
 593     return
 594         if $appclass->config->{disable_component_resolution_regex_fallback};
 595
 596     # regexp fallback
 597     $query  = qr/$name/i;
 598     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 599
 600     # no results? try against full names
 601     if( !@result ) {
 602         @result = grep { m{$query} } keys %eligible;
 603     }
 604
 605     # don't warn if we didn't find any results, it just might not exist
 606     if( @result ) {
 607         # Disgusting hack to work out correct method name
 608         my $warn_for = lc $prefixes[0];
 609         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
 610            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
 611            "component resolution is unreliable and unsafe.";
 612         my $short = $result[0];
 613         # remove the component namespace prefix
 614         $short =~ s/.*?(Model|Controller|View):://;
 615         my $shortmess = Carp::shortmess('');
 616         if ($shortmess =~ m#Catalyst/Plugin#) {
 617            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 618               "plugin's config";
 619         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
 620            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 621               "component's config";
 622         } else {
 623            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
 624               "but if you really wanted to search, pass in a regexp as the argument " .
 625               "like so: \$c->${warn_for}(qr/${name}/)";
 626         }
 627         $c->log->warn( "${msg}$shortmess" );
 628     }
 629
 630     return @result;
 631 }
 632
 633 # Find possible names for a prefix
 634 sub _comp_names {
 635     my ( $c, @prefixes ) = @_;
 636     my $appclass = ref $c || $c;
 637
 638     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 639
 640     my @names = map { s{$filter}{}; $_; }
 641         $c->_comp_names_search_prefixes( undef, @prefixes );
 642
 643     return @names;
 644 }
 645
 646 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 647 sub _filter_component {
 648     my ( $c, $comp, @args ) = @_;
 649
 650     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 651         return $comp->ACCEPT_CONTEXT( $c, @args );
 652     }
 653
 654     return $comp;
 655 }
 656
 657 =head2 COMPONENT ACCESSORS
 658
 659 =head2 $c->controller($name)
 660
 661 Gets a L<Catalyst::Controller> instance by name.
 662
 663     $c->controller('Foo')->do_stuff;
 664
 665 If the name is omitted, will return the controller for the dispatched
 666 action.
 667
 668 If you want to search for controllers, pass in a regexp as the argument.
 669
 670     # find all controllers that start with Foo
 671     my @foo_controllers = $c->controller(qr{^Foo});
 672
 673
 674 =cut
 675
 676 sub controller {
 677     my ( $c, $name, @args ) = @_;
 678
 679     my $appclass = ref($c) || $c;
 680     if( $name ) {
 681         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
 682             my $comps = $c->components;
 683             my $check = $appclass."::Controller::".$name;
 684             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 685             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     ## I think this mess is to support the old nested
3090     if ( ref $value eq 'ARRAY' ) {
3091         foreach ( @$value ) {
3092             $_ = $self->_handle_unicode_decoding($_);
3093         }
3094         return $value;
3095     }
3096     elsif ( ref $value eq 'HASH' ) {
3097         foreach ( values %$value ) {
3098             $_ = $self->_handle_unicode_decoding($_);
3099         }
3100         return $value;
3101     }
3102     else {
3103         return $self->_handle_param_unicode_decoding($value);
3104     }
3105 }
3106
3107 sub _handle_param_unicode_decoding {
3108     my ( $self, $value ) = @_;
3109     return unless defined $value; # not in love with just ignoring undefs - jnap
3110
3111     my $enc = $self->encoding;
3112     return try {
3113         Encode::is_utf8( $value ) ?
3114             $value
3115         : $enc->decode( $value, $self->_encode_check );
3116     }
3117     catch {
3118         $self->handle_unicode_encoding_exception({
3119             param_value => $value,
3120             error_msg => $_,
3121             encoding_step => 'params',
3122         });
3123     };
3124 }
3125
3126 =head2 $c->setup_log
3127
3128 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
3129 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
3130 log to.
3131
3132 This method also installs a C<debug> method that returns a true value into the
3133 catalyst subclass if the "debug" level is passed in the comma-delimited list,
3134 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
3135
3136 Note that if the log has already been setup, by either a previous call to
3137 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
3138 that this method won't actually set up the log object.
3139
3140 =cut
3141
3142 sub setup_log {
3143     my ( $class, $levels ) = @_;
3144
3145     $levels ||= '';
3146     $levels =~ s/^\s+//;
3147     $levels =~ s/\s+$//;
3148     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
3149
3150     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
3151     if ( defined $env_debug ) {
3152         $levels{debug} = 1 if $env_debug; # Ugly!
3153         delete($levels{debug}) unless $env_debug;
3154     }
3155
3156     unless ( $class->log ) {
3157         $class->log( Catalyst::Log->new(keys %levels) );
3158     }
3159
3160     if ( $levels{debug} ) {
3161         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
3162         $class->log->debug('Debug messages enabled');
3163     }
3164 }
3165
3166 =head2 $c->setup_plugins
3167
3168 Sets up plugins.
3169
3170 =cut
3171
3172 =head2 $c->setup_stats
3173
3174 Sets up timing statistics class.
3175
3176 =cut
3177
3178 sub setup_stats {
3179     my ( $class, $stats ) = @_;
3180
3181     Catalyst::Utils::ensure_class_loaded($class->stats_class);
3182
3183     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
3184     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
3185         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
3186         $class->log->debug('Statistics enabled');
3187     }
3188 }
3189
3190
3191 =head2 $c->registered_plugins
3192
3193 Returns a sorted list of the plugins which have either been stated in the
3194 import list.
3195
3196 If passed a given plugin name, it will report a boolean value indicating
3197 whether or not that plugin is loaded.  A fully qualified name is required if
3198 the plugin name does not begin with C<Catalyst::Plugin::>.
3199
3200  if ($c->registered_plugins('Some::Plugin')) {
3201      ...
3202  }
3203
3204 =cut
3205
3206 {
3207
3208     sub registered_plugins {
3209         my $proto = shift;
3210         return sort keys %{ $proto->_plugins } unless @_;
3211         my $plugin = shift;
3212         return 1 if exists $proto->_plugins->{$plugin};
3213         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
3214     }
3215
3216     sub _register_plugin {
3217         my ( $proto, $plugin, $instant ) = @_;
3218         my $class = ref $proto || $proto;
3219
3220         load_class( $plugin );
3221         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
3222             if $plugin->isa( 'Catalyst::Component' );
3223         my $plugin_meta = Moose::Meta::Class->create($plugin);
3224         if (!$plugin_meta->has_method('new')
3225             && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
3226             $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
3227         }
3228         if (!$instant && !$proto->_plugins->{$plugin}) {
3229             my $meta = Class::MOP::get_metaclass_by_name($class);
3230             $meta->superclasses($plugin, $meta->superclasses);
3231         }
3232         $proto->_plugins->{$plugin} = 1;
3233         return $class;
3234     }
3235
3236     sub _default_plugins { return qw() }
3237
3238     sub setup_plugins {
3239         my ( $class, $plugins ) = @_;
3240
3241         $class->_plugins( {} ) unless $class->_plugins;
3242         $plugins = [ grep {
3243             m/Unicode::Encoding/ ? do {
3244                 $class->log->warn(
3245                     'Unicode::Encoding plugin is auto-applied,'
3246                     . ' please remove this from your appclass'
3247                     . ' and make sure to define "encoding" config'
3248                 );
3249                 unless (exists $class->config->{'encoding'}) {
3250                   $class->config->{'encoding'} = 'UTF-8';
3251                 }
3252                 () }
3253                 : $_
3254         } @$plugins ];
3255         push @$plugins, $class->_default_plugins;
3256         $plugins = Data::OptList::mkopt($plugins || []);
3257
3258         my @plugins = map {
3259             [ Catalyst::Utils::resolve_namespace(
3260                   $class . '::Plugin',
3261                   'Catalyst::Plugin', $_->[0]
3262               ),
3263               $_->[1],
3264             ]
3265          } @{ $plugins };
3266
3267         for my $plugin ( reverse @plugins ) {
3268             load_class($plugin->[0], $plugin->[1]);
3269             my $meta = find_meta($plugin->[0]);
3270             next if $meta && $meta->isa('Moose::Meta::Role');
3271
3272             $class->_register_plugin($plugin->[0]);
3273         }
3274
3275         my @roles =
3276             map  { $_->[0]->name, $_->[1] }
3277             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
3278             map  { [find_meta($_->[0]), $_->[1]] }
3279             @plugins;
3280
3281         Moose::Util::apply_all_roles(
3282             $class => @roles
3283         ) if @roles;
3284     }
3285 }
3286
3287 =head2 registered_middlewares
3288
3289 Read only accessor that returns an array of all the middleware in the order
3290 that they were added (which is the REVERSE of the order they will be applied).
3291
3292 The values returned will be either instances of L<Plack::Middleware> or of a
3293 compatible interface, or a coderef, which is assumed to be inlined middleware
3294
3295 =head2 setup_middleware (?@middleware)
3296
3297 Read configuration information stored in configuration key C<psgi_middleware> or
3298 from passed @args.
3299
3300 See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
3301 to use it to enable L<Plack::Middleware>
3302
3303 This method is automatically called during 'setup' of your application, so
3304 you really don't need to invoke it.  However you may do so if you find the idea
3305 of loading middleware via configuration weird :).  For example:
3306
3307     package MyApp;
3308
3309     use Catalyst;
3310
3311     __PACKAGE__->setup_middleware('Head');
3312     __PACKAGE__->setup;
3313
3314 When we read middleware definitions from configuration, we reverse the list
3315 which sounds odd but is likely how you expect it to work if you have prior
3316 experience with L<Plack::Builder> or if you previously used the plugin
3317 L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
3318
3319 So basically your middleware handles an incoming request from the first
3320 registered middleware, down and handles the response from the last middleware
3321 up.
3322
3323 =cut
3324
3325 sub registered_middlewares {
3326     my $class = shift;
3327     if(my $middleware = $class->_psgi_middleware) {
3328         return (
3329           Catalyst::Middleware::Stash->new,
3330           Plack::Middleware::HTTPExceptions->new,
3331           Plack::Middleware::RemoveRedundantBody->new,
3332           Plack::Middleware::FixMissingBodyInRedirect->new,
3333           Plack::Middleware::ContentLength->new,
3334           Plack::Middleware::MethodOverride->new,
3335           Plack::Middleware::Head->new,
3336           @$middleware);
3337     } else {
3338         die "You cannot call ->registered_middlewares until middleware has been setup";
3339     }
3340 }
3341
3342 sub setup_middleware {
3343     my $class = shift;
3344     my @middleware_definitions = @_ ?
3345       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
3346
3347     my @middleware = ();
3348     while(my $next = shift(@middleware_definitions)) {
3349         if(ref $next) {
3350             if(Scalar::Util::blessed $next && $next->can('wrap')) {
3351                 push @middleware, $next;
3352             } elsif(ref $next eq 'CODE') {
3353                 push @middleware, $next;
3354             } elsif(ref $next eq 'HASH') {
3355                 my $namespace = shift @middleware_definitions;
3356                 my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
3357                 push @middleware, $mw;
3358             } else {
3359               die "I can't handle middleware definition ${\ref $next}";
3360             }
3361         } else {
3362           my $mw = $class->Catalyst::Utils::build_middleware($next);
3363           push @middleware, $mw;
3364         }
3365     }
3366
3367     my @existing = @{$class->_psgi_middleware || []};
3368     $class->_psgi_middleware([@middleware,@existing,]);
3369 }
3370
3371 =head2 registered_data_handlers
3372
3373 A read only copy of registered Data Handlers returned as a Hash, where each key
3374 is a content type and each value is a subref that attempts to decode that content
3375 type.
3376
3377 =head2 setup_data_handlers (?@data_handler)
3378
3379 Read configuration information stored in configuration key C<data_handlers> or
3380 from passed @args.
3381
3382 See under L</CONFIGURATION> information regarding C<data_handlers>.
3383
3384 This method is automatically called during 'setup' of your application, so
3385 you really don't need to invoke it.
3386
3387 =head2 default_data_handlers
3388
3389 Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
3390 only two default data handlers, for 'application/json' and an alternative to
3391 'application/x-www-form-urlencoded' which supposed nested form parameters via
3392 L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
3393
3394 The 'application/json' data handler is used to parse incoming JSON into a Perl
3395 data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
3396 is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
3397 JSON decoder, and has the smallest dependency impact.
3398
3399 Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
3400 use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
3401 order to get the best performance.  You should add either to your dependency
3402 list (Makefile.PL, dist.ini, cpanfile, etc.)
3403
3404 =cut
3405
3406 sub registered_data_handlers {
3407     my $class = shift;
3408     if(my $data_handlers = $class->_data_handlers) {
3409         return %$data_handlers;
3410     } else {
3411         $class->setup_data_handlers;
3412         return $class->registered_data_handlers;
3413     }
3414 }
3415
3416 sub setup_data_handlers {
3417     my ($class, %data_handler_callbacks) = @_;
3418     %data_handler_callbacks = (
3419       %{$class->default_data_handlers},
3420       %{$class->config->{'data_handlers'}||+{}},
3421       %data_handler_callbacks);
3422
3423     $class->_data_handlers(\%data_handler_callbacks);
3424 }
3425
3426 sub default_data_handlers {
3427     my ($class) = @_;
3428     return +{
3429       'application/x-www-form-urlencoded' => sub {
3430           my ($fh, $req) = @_;
3431           my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
3432           Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
3433             ->can('build_cgi_struct')->($params);
3434       },
3435       'application/json' => sub {
3436           Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
3437             ->can('decode_json')->(do { local $/; $_->getline });
3438       },
3439     };
3440 }
3441
3442 =head2 $c->stack
3443
3444 Returns an arrayref of the internal execution stack (actions that are
3445 currently executing).
3446
3447 =head2 $c->stats
3448
3449 Returns the current timing statistics object. By default Catalyst uses
3450 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
3451 L<< stats_class|/"$c->stats_class" >>.
3452
3453 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
3454 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
3455 profile explicitly, although MyApp.pm still won't profile nor output anything
3456 by itself.
3457
3458 =head2 $c->stats_class
3459
3460 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
3461
3462 =head2 $c->use_stats
3463
3464 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
3465
3466 Note that this is a static method, not an accessor and should be overridden
3467 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
3468
3469 =cut
3470
3471 sub use_stats { 0 }
3472
3473
3474 =head2 $c->write( $data )
3475
3476 Writes $data to the output stream. When using this method directly, you
3477 will need to manually set the C<Content-Length> header to the length of
3478 your output data, if known.
3479
3480 =cut
3481
3482 sub write {
3483     my $c = shift;
3484
3485     # Finalize headers if someone manually writes output (for compat)
3486     $c->finalize_headers;
3487
3488     return $c->response->write( @_ );
3489 }
3490
3491 =head2 version
3492
3493 Returns the Catalyst version number. Mostly useful for "powered by"
3494 messages in template systems.
3495
3496 =cut
3497
3498 sub version { return $Catalyst::VERSION }
3499
3500 =head1 CONFIGURATION
3501
3502 There are a number of 'base' config variables which can be set:
3503
3504 =over
3505
3506 =item *
3507
3508 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
3509
3510 =item *
3511
3512 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
3513
3514 =item *
3515
3516 C<disable_component_resolution_regex_fallback> - Turns
3517 off the deprecated component resolution functionality so
3518 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
3519 are called then regex search will not be attempted on string values and
3520 instead C<undef> will be returned.
3521
3522 =item *
3523
3524 C<home> - The application home directory. In an uninstalled application,
3525 this is the top level application directory. In an installed application,
3526 this will be the directory containing C<< MyApp.pm >>.
3527
3528 =item *
3529
3530 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3531
3532 =item *
3533
3534 C<name> - The name of the application in debug messages and the debug and
3535 welcome screens
3536
3537 =item *
3538
3539 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3540 until it is accessed. This allows you to (for example) check authentication (and reject
3541 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
3542
3543 =item *
3544
3545 C<root> - The root directory for templates. Usually this is just a
3546 subdirectory of the home directory, but you can set it to change the
3547 templates to a different directory.
3548
3549 =item *
3550
3551 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3552 namespaces from which components will be loaded (and constructed and stored in
3553 C<< $c->components >>).
3554
3555 =item *
3556
3557 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3558 to be shown in hit debug tables in the test server.
3559
3560 =item *
3561
3562 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
3563 variable should be used for determining the request path.
3564
3565 Most web server environments pass the requested path to the application using environment variables,
3566 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
3567 exposed as C<< $c->request->base >>) and the request path below that base.
3568
3569 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
3570 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
3571
3572 =over
3573
3574 =item use_request_uri_for_path => 0
3575
3576 This is the default (and the) traditional method that Catalyst has used for determining the path information.
3577 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
3578 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
3579 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
3580
3581 However this method has the major disadvantage that it is impossible to correctly decode some elements
3582 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
3583 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
3584 can't distinguish / vs %2F in paths (in addition to other encoded values).
3585
3586 =item use_request_uri_for_path => 1
3587
3588 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
3589 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
3590 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
3591
3592 Given that this method of path resolution is provably more correct, it is recommended that you use
3593 this unless you have a specific need to deploy your application in a non-standard environment, and you are
3594 aware of the implications of not being able to handle encoded URI paths correctly.
3595
3596 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
3597 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
3598 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
3599 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
3600 C<< $c->request->base >> will be incorrect.
3601
3602 =back
3603
3604 =item *
3605
3606 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3607
3608 =item *
3609
3610 C<encoding> - See L</ENCODING>
3611
3612 =item *
3613
3614 C<abort_chain_on_error_fix>
3615
3616 When there is an error in an action chain, the default behavior is to continue
3617 processing the remaining actions and then catch the error upon chain end.  This
3618 can lead to running actions when the application is in an unexpected state.  If
3619 you have this issue, setting this config value to true will promptly exit a
3620 chain when there is an error raised in any action (thus terminating the chain
3621 early.)
3622
3623 use like:
3624
3625     __PACKAGE__->config(abort_chain_on_error_fix => 1);
3626
3627 In the future this might become the default behavior.
3628
3629 =item *
3630
3631 C<use_hash_multivalue_in_request>
3632
3633 In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
3634 and C<parameters> return a hashref where values might be scalar or an arrayref
3635 depending on the incoming data.  In many cases this can be undesirable as it
3636 leads one to writing defensive code like the following:
3637
3638     my ($val) = ref($c->req->parameters->{a}) ?
3639       @{$c->req->parameters->{a}} :
3640         $c->req->parameters->{a};
3641
3642 Setting this configuration item to true will make L<Catalyst> populate the
3643 attributes underlying these methods with an instance of L<Hash::MultiValue>
3644 which is used by L<Plack::Request> and others to solve this very issue.  You
3645 may prefer this behavior to the default, if so enable this option (be warned
3646 if you enable it in a legacy application we are not sure if it is completely
3647 backwardly compatible).
3648
3649 =item *
3650
3651 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
3652
3653 =item *
3654
3655 C<data_handlers> - See L<DATA HANDLERS>.
3656
3657 =back
3658
3659 =head1 EXCEPTIONS
3660
3661 Generally when you throw an exception inside an Action (or somewhere in
3662 your stack, such as in a model that an Action is calling) that exception
3663 is caught by Catalyst and unless you either catch it yourself (via eval
3664 or something like L<Try::Tiny> or by reviewing the L</error> stack, it
3665 will eventually reach L</finalize_errors> and return either the debugging
3666 error stack page, or the default error page.  However, if your exception
3667 can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
3668 instead rethrow it so that it can be handled by that middleware (which
3669 is part of the default middleware).  For example this would allow
3670
3671     use HTTP::Throwable::Factory 'http_throw';
3672
3673     sub throws_exception :Local {
3674       my ($self, $c) = @_;
3675
3676       http_throw(SeeOther => { location =>
3677         $c->uri_for($self->action_for('redirect')) });
3678
3679     }
3680
3681 =head1 INTERNAL ACTIONS
3682
3683 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3684 C<_ACTION>, and C<_END>. These are by default not shown in the private
3685 action table, but you can make them visible with a config parameter.
3686
3687     MyApp->config(show_internal_actions => 1);
3688
3689 =head1 ON-DEMAND PARSER
3690
3691 The request body is usually parsed at the beginning of a request,
3692 but if you want to handle input yourself, you can enable on-demand
3693 parsing with a config parameter.
3694
3695     MyApp->config(parse_on_demand => 1);
3696
3697 =head1 PROXY SUPPORT
3698
3699 Many production servers operate using the common double-server approach,
3700 with a lightweight frontend web server passing requests to a larger
3701 backend server. An application running on the backend server must deal
3702 with two problems: the remote user always appears to be C<127.0.0.1> and
3703 the server's hostname will appear to be C<localhost> regardless of the
3704 virtual host that the user connected through.
3705
3706 Catalyst will automatically detect this situation when you are running
3707 the frontend and backend servers on the same machine. The following
3708 changes are made to the request.
3709
3710     $c->req->address is set to the user's real IP address, as read from
3711     the HTTP X-Forwarded-For header.
3712
3713     The host value for $c->req->base and $c->req->uri is set to the real
3714     host, as read from the HTTP X-Forwarded-Host header.
3715
3716 Additionally, you may be running your backend application on an insecure
3717 connection (port 80) while your frontend proxy is running under SSL.  If there
3718 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3719 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3720 be created properly.
3721
3722 In the case of passing in:
3723
3724     X-Forwarded-Port: 443
3725
3726 All calls to C<uri_for> will result in an https link, as is expected.
3727
3728 Obviously, your web server must support these headers for this to work.
3729
3730 In a more complex server farm environment where you may have your
3731 frontend proxy server(s) on different machines, you will need to set a
3732 configuration option to tell Catalyst to read the proxied data from the
3733 headers.
3734
3735     MyApp->config(using_frontend_proxy => 1);
3736
3737 If you do not wish to use the proxy support at all, you may set:
3738
3739     MyApp->config(ignore_frontend_proxy => 0);
3740
3741 =head2 Note about psgi files
3742
3743 Note that if you supply your own .psgi file, calling
3744 C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>.
3745
3746 You either need to apply L<Plack::Middleware::ReverseProxy> yourself
3747 in your psgi, for example:
3748
3749     builder {
3750         enable "Plack::Middleware::ReverseProxy";
3751         MyApp->psgi_app
3752     };
3753
3754 This will unconditionally add the ReverseProxy support, or you need to call
3755 C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
3756 apply the support depending upon your config).
3757
3758 See L<Catalyst::PSGI> for more information.
3759
3760 =head1 THREAD SAFETY
3761
3762 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3763 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3764 believe the Catalyst core to be thread-safe.
3765
3766 If you plan to operate in a threaded environment, remember that all other
3767 modules you are using must also be thread-safe. Some modules, most notably
3768 L<DBD::SQLite>, are not thread-safe.
3769
3770 =head1 DATA HANDLERS
3771
3772 The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
3773 form parameters and URL search query fields.  However it has become common
3774 for various alternative content types to be PUT or POSTed to your controllers
3775 and actions.  People working on RESTful APIs, or using AJAX often use JSON,
3776 XML and other content types when communicating with an application server.  In
3777 order to better support this use case, L<Catalyst> defines a global configuration
3778 option, C<data_handlers>, which lets you associate a content type with a coderef
3779 that parses that content type into something Perl can readily access.
3780
3781     package MyApp::Web;
3782
3783     use Catalyst;
3784     use JSON::Maybe;
3785
3786     __PACKAGE__->config(
3787       data_handlers => {
3788         'application/json' => sub { local $/; decode_json $_->getline },
3789       },
3790       ## Any other configuration.
3791     );
3792
3793     __PACKAGE__->setup;
3794
3795 By default L<Catalyst> comes with a generic JSON data handler similar to the
3796 example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
3797 (a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
3798 it installed (if you want the faster XS parser, add it to you project Makefile.PL
3799 or dist.ini, cpanfile, etc.)
3800
3801 The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types
3802 (matched against the incoming request type using a regexp such as to be case
3803 insensitive) and whose values are coderefs that receive a localized version of
3804 C<$_> which is a filehandle object pointing to received body.
3805
3806 This feature is considered an early access release and we reserve the right
3807 to alter the interface in order to provide a performant and secure solution to
3808 alternative request body content.  Your reports welcomed!
3809
3810 =head1 PSGI MIDDLEWARE
3811
3812 You can define middleware, defined as L<Plack::Middleware> or a compatible
3813 interface in configuration.  Your middleware definitions are in the form of an
3814 arrayref under the configuration key C<psgi_middleware>.  Here's an example
3815 with details to follow:
3816
3817     package MyApp::Web;
3818
3819     use Catalyst;
3820     use Plack::Middleware::StackTrace;
3821
3822     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3823
3824     __PACKAGE__->config(
3825       'psgi_middleware', [
3826         'Debug',
3827         '+MyApp::Custom',
3828         $stacktrace_middleware,
3829         'Session' => {store => 'File'},
3830         sub {
3831           my $app = shift;
3832           return sub {
3833             my $env = shift;
3834             $env->{myapp.customkey} = 'helloworld';
3835             $app->($env);
3836           },
3837         },
3838       ],
3839     );
3840
3841     __PACKAGE__->setup;
3842
3843 So the general form is:
3844
3845     __PACKAGE__->config(psgi_middleware => \@middleware_definitions);
3846
3847 Where C<@middleware> is one or more of the following, applied in the REVERSE of
3848 the order listed (to make it function similarly to L<Plack::Builder>:
3849
3850 Alternatively, you may also define middleware by calling the L</setup_middleware>
3851 package method:
3852
3853     package MyApp::Web;
3854
3855     use Catalyst;
3856
3857     __PACKAGE__->setup_middleware( \@middleware_definitions);
3858     __PACKAGE__->setup;
3859
3860 In the case where you do both (use 'setup_middleware' and configuration) the
3861 package call to setup_middleware will be applied earlier (in other words its
3862 middleware will wrap closer to the application).  Keep this in mind since in
3863 some cases the order of middleware is important.
3864
3865 The two approaches are not exclusive.
3866
3867 =over 4
3868
3869 =item Middleware Object
3870
3871 An already initialized object that conforms to the L<Plack::Middleware>
3872 specification:
3873
3874     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3875
3876     __PACKAGE__->config(
3877       'psgi_middleware', [
3878         $stacktrace_middleware,
3879       ]);
3880
3881
3882 =item coderef
3883
3884 A coderef that is an inlined middleware:
3885
3886     __PACKAGE__->config(
3887       'psgi_middleware', [
3888         sub {
3889           my $app = shift;
3890           return sub {
3891             my $env = shift;
3892             if($env->{PATH_INFO} =~m/forced/) {
3893               Plack::App::File
3894                 ->new(file=>TestApp->path_to(qw/share static forced.txt/))
3895                 ->call($env);
3896             } else {
3897               return $app->($env);
3898             }
3899          },
3900       },
3901     ]);
3902
3903
3904
3905 =item a scalar
3906
3907 We assume the scalar refers to a namespace after normalizing it using the
3908 following rules:
3909
3910 (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string
3911 is assumed to be 'as is', and we just install and use the middleware.
3912
3913 (2) If the scalar begins with "Plack::Middleware" or your application namespace
3914 (the package name of your Catalyst application subclass), we also assume then
3915 that it is a full namespace, and use it.
3916
3917 (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to
3918 resolve it first by looking for it under your application namespace (for example
3919 if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look
3920 under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we
3921 will then look under the regular L<Plack::Middleware> namespace (i.e. for the
3922 previous we'd try "Plack::Middleware::MyMiddleware").  We look under your application
3923 namespace first to let you 'override' common L<Plack::Middleware> locally, should
3924 you find that a good idea.
3925
3926 Examples:
3927
3928     package MyApp::Web;
3929
3930     __PACKAGE__->config(
3931       'psgi_middleware', [
3932         'Debug',  ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap
3933         'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap
3934         '+MyApp::Custom',  ## MyApp::Custom->wrap
3935       ],
3936     );
3937
3938 =item a scalar followed by a hashref
3939
3940 Just like the previous, except the following C<HashRef> is used as arguments
3941 to initialize the middleware object.
3942
3943     __PACKAGE__->config(
3944       'psgi_middleware', [
3945          'Session' => {store => 'File'},
3946     ]);
3947
3948 =back
3949
3950 Please see L<PSGI> for more on middleware.
3951
3952 =head1 ENCODING
3953
3954 On request, decodes all params from encoding into a sequence of
3955 logical characters. On response, encodes body into encoding.
3956
3957 =head2 Methods
3958
3959 =over 4
3960
3961 =item encoding
3962
3963 Returns an instance of an C<Encode> encoding
3964
3965     print $c->encoding->name
3966
3967 =item handle_unicode_encoding_exception ($exception_context)
3968
3969 Method called when decoding process for a request fails.
3970
3971 An C<$exception_context> hashref is provided to allow you to override the
3972 behaviour of your application when given data with incorrect encodings.
3973
3974 The default method throws exceptions in the case of invalid request parameters
3975 (resulting in a 500 error), but ignores errors in upload filenames.
3976
3977 The keys passed in the C<$exception_context> hash are:
3978
3979 =over
3980
3981 =item param_value
3982
3983 The value which was not able to be decoded.
3984
3985 =item error_msg
3986
3987 The exception received from L<Encode>.
3988
3989 =item encoding_step
3990
3991 What type of data was being decoded. Valid values are (currently)
3992 C<params> - for request parameters / arguments / captures
3993 and C<uploads> - for request upload filenames.
3994
3995 =back
3996
3997 =back
3998
3999 =head1 SUPPORT
4000
4001 IRC:
4002
4003     Join #catalyst on irc.perl.org.
4004
4005 Mailing Lists:
4006
4007     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
4008     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
4009
4010 Web:
4011
4012     http://catalyst.perl.org
4013
4014 Wiki:
4015
4016     http://dev.catalyst.perl.org
4017
4018 =head1 SEE ALSO
4019
4020 =head2 L<Task::Catalyst> - All you need to start with Catalyst
4021
4022 =head2 L<Catalyst::Manual> - The Catalyst Manual
4023
4024 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
4025
4026 =head2 L<Catalyst::Engine> - Core engine
4027
4028 =head2 L<Catalyst::Log> - Log class.
4029
4030 =head2 L<Catalyst::Request> - Request object
4031
4032 =head2 L<Catalyst::Response> - Response object
4033
4034 =head2 L<Catalyst::Test> - The test suite.
4035
4036 =head1 PROJECT FOUNDER
4037
4038 sri: Sebastian Riedel <sri@cpan.org>
4039
4040 =head1 CONTRIBUTORS
4041
4042 abw: Andy Wardley
4043
4044 acme: Leon Brocard <leon@astray.com>
4045
4046 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
4047
4048 Andrew Bramble
4049
4050 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
4051
4052 Andrew Ruthven
4053
4054 andyg: Andy Grundman <andy@hybridized.org>
4055
4056 audreyt: Audrey Tang
4057
4058 bricas: Brian Cassidy <bricas@cpan.org>
4059
4060 Caelum: Rafael Kitover <rkitover@io.com>
4061
4062 chansen: Christian Hansen
4063
4064 chicks: Christopher Hicks
4065
4066 Chisel Wright C<pause@herlpacker.co.uk>
4067
4068 Danijel Milicevic C<me@danijel.de>
4069
4070 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
4071
4072 David Naughton, C<naughton@umn.edu>
4073
4074 David E. Wheeler
4075
4076 dhoss: Devin Austin <dhoss@cpan.org>
4077
4078 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
4079
4080 Drew Taylor
4081
4082 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
4083
4084 esskar: Sascha Kiefer
4085
4086 fireartist: Carl Franks <cfranks@cpan.org>
4087
4088 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
4089
4090 gabb: Danijel Milicevic
4091
4092 Gary Ashton Jones
4093
4094 Gavin Henry C<ghenry@perl.me.uk>
4095
4096 Geoff Richards
4097
4098 groditi: Guillermo Roditi <groditi@gmail.com>
4099
4100 hobbs: Andrew Rodland <andrew@cleverdomain.org>
4101
4102 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
4103
4104 jcamacho: Juan Camacho
4105
4106 jester: Jesse Sheidlower C<jester@panix.com>
4107
4108 jhannah: Jay Hannah <jay@jays.net>
4109
4110 Jody Belka
4111
4112 Johan Lindstrom
4113
4114 jon: Jon Schutz <jjschutz@cpan.org>
4115
4116 Jonathan Rockway C<< <jrockway@cpan.org> >>
4117
4118 Kieren Diment C<kd@totaldatasolution.com>
4119
4120 konobi: Scott McWhirter <konobi@cpan.org>
4121
4122 marcus: Marcus Ramberg <mramberg@cpan.org>
4123
4124 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
4125
4126 mgrimes: Mark Grimes <mgrimes@cpan.org>
4127
4128 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
4129
4130 mugwump: Sam Vilain
4131
4132 naughton: David Naughton
4133
4134 ningu: David Kamholz <dkamholz@cpan.org>
4135
4136 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
4137
4138 numa: Dan Sully <daniel@cpan.org>
4139
4140 obra: Jesse Vincent
4141
4142 Octavian Rasnita
4143
4144 omega: Andreas Marienborg
4145
4146 Oleg Kostyuk <cub.uanic@gmail.com>
4147
4148 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
4149
4150 rafl: Florian Ragwitz <rafl@debian.org>
4151
4152 random: Roland Lammel <lammel@cpan.org>
4153
4154 Robert Sedlacek C<< <rs@474.at> >>
4155
4156 SpiceMan: Marcel Montes
4157
4158 sky: Arthur Bergman
4159
4160 szbalint: Balint Szilakszi <szbalint@cpan.org>
4161
4162 t0m: Tomas Doran <bobtfish@bobtfish.net>
4163
4164 Ulf Edvinsson
4165
4166 vanstyn: Henry Van Styn <vanstyn@cpan.org>
4167
4168 Viljo Marrandi C<vilts@yahoo.com>
4169
4170 Will Hawes C<info@whawes.co.uk>
4171
4172 willert: Sebastian Willert <willert@cpan.org>
4173
4174 wreis: Wallace Reis <wreis@cpan.org>
4175
4176 Yuval Kogman, C<nothingmuch@woobling.org>
4177
4178 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
4179
4180 dd070: Dhaval Dhanani <dhaval070@gmail.com>
4181
4182 Upasana <me@upasana.me>
4183
4184 =head1 COPYRIGHT
4185
4186 Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
4187
4188 =head1 LICENSE
4189
4190 This library is free software. You can redistribute it and/or modify it under
4191 the same terms as Perl itself.
4192
4193 =cut
4194
4195 no Moose;
4196
4197 __PACKAGE__->meta->make_immutable;
4198
4199 1;