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