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 B::Hooks::EndOfScope ();
   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 File::stat;
  20 use Module::Pluggable::Object ();
  21 use Text::SimpleTable ();
  22 use Path::Class::Dir ();
  23 use Path::Class::File ();
  24 use URI ();
  25 use URI::http;
  26 use URI::https;
  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 utf8;
  34 use Carp qw/croak carp shortmess/;
  35 use Try::Tiny;
  36
  37 BEGIN { require 5.008004; }
  38
  39 has stack => (is => 'ro', default => sub { [] });
  40 has stash => (is => 'rw', default => sub { {} });
  41 has state => (is => 'rw', default => 0);
  42 has stats => (is => 'rw');
  43 has action => (is => 'rw');
  44 has counter => (is => 'rw', default => sub { {} });
  45 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
  46 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
  47 has namespace => (is => 'rw');
  48
  49 sub depth { scalar @{ shift->stack || [] }; }
  50 sub comp { shift->component(@_) }
  51
  52 sub req {
  53     my $self = shift; return $self->request(@_);
  54 }
  55 sub res {
  56     my $self = shift; return $self->response(@_);
  57 }
  58
  59 # For backwards compatibility
  60 sub finalize_output { shift->finalize_body(@_) };
  61
  62 # For statistics
  63 our $COUNT     = 1;
  64 our $START     = time;
  65 our $RECURSION = 1000;
  66 our $DETACH    = Catalyst::Exception::Detach->new;
  67 our $GO        = Catalyst::Exception::Go->new;
  68
  69 #I imagine that very few of these really need to be class variables. if any.
  70 #maybe we should just make them attributes with a default?
  71 __PACKAGE__->mk_classdata($_)
  72   for qw/components arguments dispatcher engine log dispatcher_class
  73   engine_class context_class request_class response_class stats_class
  74   setup_finished psgi_app/;
  75
  76 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  77 __PACKAGE__->engine_class('Catalyst::Engine');
  78 __PACKAGE__->request_class('Catalyst::Request');
  79 __PACKAGE__->response_class('Catalyst::Response');
  80 __PACKAGE__->stats_class('Catalyst::Stats');
  81
  82 # Remember to update this in Catalyst::Runtime as well!
  83
  84 our $VERSION = '5.80024';
  85
  86 sub import {
  87     my ( $class, @arguments ) = @_;
  88
  89     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  90     # callers @ISA.
  91     return unless $class eq 'Catalyst';
  92
  93     my $caller = caller();
  94     return if $caller eq 'main';
  95
  96     my $meta = Moose::Meta::Class->initialize($caller);
  97     unless ( $caller->isa('Catalyst') ) {
  98         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
  99         $meta->superclasses(@superclasses);
 100     }
 101     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
 102     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 103
 104     unless( $meta->has_method('meta') ){
 105         $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
 106     }
 107
 108     $caller->arguments( [@arguments] );
 109     $caller->setup_home;
 110 }
 111
 112 sub _application { $_[0] }
 113
 114 =head1 NAME
 115
 116 Catalyst - The Elegant MVC Web Application Framework
 117
 118 =head1 SYNOPSIS
 119
 120 See the L<Catalyst::Manual> distribution for comprehensive
 121 documentation and tutorials.
 122
 123     # Install Catalyst::Devel for helpers and other development tools
 124     # use the helper to create a new application
 125     catalyst.pl MyApp
 126
 127     # add models, views, controllers
 128     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 129     script/myapp_create.pl view MyTemplate TT
 130     script/myapp_create.pl controller Search
 131
 132     # built in testserver -- use -r to restart automatically on changes
 133     # --help to see all available options
 134     script/myapp_server.pl
 135
 136     # command line testing interface
 137     script/myapp_test.pl /yada
 138
 139     ### in lib/MyApp.pm
 140     use Catalyst qw/-Debug/; # include plugins here as well
 141
 142     ### In lib/MyApp/Controller/Root.pm (autocreated)
 143     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 144         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 145         $c->stash->{template} = 'foo.tt'; # set the template
 146         # lookup something from db -- stash vars are passed to TT
 147         $c->stash->{data} =
 148           $c->model('Database::Foo')->search( { country => $args[0] } );
 149         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 150             $c->forward( 'bar' ); # process another action
 151             # do something else after forward returns
 152         }
 153     }
 154
 155     # The foo.tt TT template can use the stash data from the database
 156     [% WHILE (item = data.next) %]
 157         [% item.foo %]
 158     [% END %]
 159
 160     # called for /bar/of/soap, /bar/of/soap/10, etc.
 161     sub bar : Path('/bar/of/soap') { ... }
 162
 163     # called for all actions, from the top-most controller downwards
 164     sub auto : Private {
 165         my ( $self, $c ) = @_;
 166         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 167             $c->res->redirect( '/login' ); # require login
 168             return 0; # abort request and go immediately to end()
 169         }
 170         return 1; # success; carry on to next action
 171     }
 172
 173     # called after all actions are finished
 174     sub end : Private {
 175         my ( $self, $c ) = @_;
 176         if ( scalar @{ $c->error } ) { ... } # handle errors
 177         return if $c->res->body; # already have a response
 178         $c->forward( 'MyApp::View::TT' ); # render template
 179     }
 180
 181     ### in MyApp/Controller/Foo.pm
 182     # called for /foo/bar
 183     sub bar : Local { ... }
 184
 185     # called for /blargle
 186     sub blargle : Global { ... }
 187
 188     # an index action matches /foo, but not /foo/1, etc.
 189     sub index : Private { ... }
 190
 191     ### in MyApp/Controller/Foo/Bar.pm
 192     # called for /foo/bar/baz
 193     sub baz : Local { ... }
 194
 195     # first Root auto is called, then Foo auto, then this
 196     sub auto : Private { ... }
 197
 198     # powerful regular expression paths are also possible
 199     sub details : Regex('^product/(\w+)/details$') {
 200         my ( $self, $c ) = @_;
 201         # extract the (\w+) from the URI
 202         my $product = $c->req->captures->[0];
 203     }
 204
 205 See L<Catalyst::Manual::Intro> for additional information.
 206
 207 =head1 DESCRIPTION
 208
 209 Catalyst is a modern framework for making web applications without the
 210 pain usually associated with this process. This document is a reference
 211 to the main Catalyst application. If you are a new user, we suggest you
 212 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 213
 214 See L<Catalyst::Manual> for more documentation.
 215
 216 Catalyst plugins can be loaded by naming them as arguments to the "use
 217 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 218 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 219 C<My::Module>.
 220
 221     use Catalyst qw/My::Module/;
 222
 223 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 224 fully qualify the name by using a unary plus:
 225
 226     use Catalyst qw/
 227         My::Module
 228         +Fully::Qualified::Plugin::Name
 229     /;
 230
 231 Special flags like C<-Debug> and C<-Engine> can also be specified as
 232 arguments when Catalyst is loaded:
 233
 234     use Catalyst qw/-Debug My::Module/;
 235
 236 The position of plugins and flags in the chain is important, because
 237 they are loaded in the order in which they appear.
 238
 239 The following flags are supported:
 240
 241 =head2 -Debug
 242
 243 Enables debug output. You can also force this setting from the system
 244 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 245 settings override the application, with <MYAPP>_DEBUG having the highest
 246 priority.
 247
 248 This sets the log level to 'debug' and enables full debug output on the
 249 error screen. If you only want the latter, see L<< $c->debug >>.
 250
 251 =head2 -Engine
 252
 253 Forces Catalyst to use a specific engine. Omit the
 254 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 255
 256     use Catalyst qw/-Engine=CGI/;
 257
 258 =head2 -Home
 259
 260 Forces Catalyst to use a specific home directory, e.g.:
 261
 262     use Catalyst qw[-Home=/usr/mst];
 263
 264 This can also be done in the shell environment by setting either the
 265 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 266 is replaced with the uppercased name of your application, any "::" in
 267 the name will be replaced with underscores, e.g. MyApp::Web should use
 268 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 269
 270 If none of these are set, Catalyst will attempt to automatically detect the
 271 home directory. If you are working in a development envirnoment, Catalyst
 272 will try and find the directory containing either Makefile.PL, Build.PL or
 273 dist.ini. If the application has been installed into the system (i.e.
 274 you have done C<make install>), then Catalyst will use the path to your
 275 application module, without the .pm extension (ie, /foo/MyApp if your
 276 application was installed at /foo/MyApp.pm)
 277
 278 =head2 -Log
 279
 280     use Catalyst '-Log=warn,fatal,error';
 281
 282 Specifies a comma-delimited list of log levels.
 283
 284 =head2 -Stats
 285
 286 Enables statistics collection and reporting.
 287
 288    use Catalyst qw/-Stats=1/;
 289
 290 You can also force this setting from the system environment with CATALYST_STATS
 291 or <MYAPP>_STATS. The environment settings override the application, with
 292 <MYAPP>_STATS having the highest priority.
 293
 294 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
 295
 296 =head1 METHODS
 297
 298 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 299
 300 =head2 $c->action
 301
 302 Returns a L<Catalyst::Action> object for the current action, which
 303 stringifies to the action name. See L<Catalyst::Action>.
 304
 305 =head2 $c->namespace
 306
 307 Returns the namespace of the current action, i.e., the URI prefix
 308 corresponding to the controller of the current action. For example:
 309
 310     # in Controller::Foo::Bar
 311     $c->namespace; # returns 'foo/bar';
 312
 313 =head2 $c->request
 314
 315 =head2 $c->req
 316
 317 Returns the current L<Catalyst::Request> object, giving access to
 318 information about the current client request (including parameters,
 319 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 320
 321 =head2 REQUEST FLOW HANDLING
 322
 323 =head2 $c->forward( $action [, \@arguments ] )
 324
 325 =head2 $c->forward( $class, $method, [, \@arguments ] )
 326
 327 Forwards processing to another action, by its private name. If you give a
 328 class name but no method, C<process()> is called. You may also optionally
 329 pass arguments in an arrayref. The action will receive the arguments in
 330 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 331 C<< $c->req->args >> will be restored to the previous values.
 332
 333 Any data C<return>ed from the action forwarded to, will be returned by the
 334 call to forward.
 335
 336     my $foodata = $c->forward('/foo');
 337     $c->forward('index');
 338     $c->forward(qw/Model::DBIC::Foo do_stuff/);
 339     $c->forward('View::TT');
 340
 341 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 342 an C<< eval { } >> around the call (actually
 343 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
 344 all 'dies' within the called action. If you want C<die> to propagate you
 345 need to do something like:
 346
 347     $c->forward('foo');
 348     die join "\n", @{ $c->error } if @{ $c->error };
 349
 350 Or make sure to always return true values from your actions and write
 351 your code like this:
 352
 353     $c->forward('foo') || return;
 354
 355 Another note is that C<< $c->forward >> always returns a scalar because it
 356 actually returns $c->state which operates in a scalar context.
 357 Thus, something like:
 358
 359     return @array;
 360
 361 in an action that is forwarded to is going to return a scalar,
 362 i.e. how many items are in that array, which is probably not what you want.
 363 If you need to return an array then return a reference to it,
 364 or stash it like so:
 365
 366     $c->stash->{array} = \@array;
 367
 368 and access it from the stash.
 369
 370 =cut
 371
 372 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
 373
 374 =head2 $c->detach( $action [, \@arguments ] )
 375
 376 =head2 $c->detach( $class, $method, [, \@arguments ] )
 377
 378 =head2 $c->detach()
 379
 380 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
 381 doesn't return to the previous action when processing is finished.
 382
 383 When called with no arguments it escapes the processing chain entirely.
 384
 385 =cut
 386
 387 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 388
 389 =head2 $c->visit( $action [, \@captures, \@arguments ] )
 390
 391 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
 392
 393 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
 394 but does a full dispatch, instead of just calling the new C<$action> /
 395 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
 396 you go to are called, just like a new request.
 397
 398 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
 399 This means, for example, that C<< $c->action >> methods such as
 400 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
 401 L<reverse|Catalyst::Action/reverse> return information for the visited action
 402 when they are invoked within the visited action.  This is different from the
 403 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 404 continues to use the $c->action object from the caller action even when
 405 invoked from the callee.
 406
 407 C<< $c->stash >> is kept unchanged.
 408
 409 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
 410 allows you to "wrap" another action, just as it would have been called by
 411 dispatching from a URL, while the analogous
 412 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
 413 transfer control to another action as if it had been reached directly from a URL.
 414
 415 =cut
 416
 417 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 418
 419 =head2 $c->go( $action [, \@captures, \@arguments ] )
 420
 421 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 422
 423 The relationship between C<go> and
 424 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
 425 the relationship between
 426 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
 427 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 428 C<< $c->go >> will perform a full dispatch on the specified action or method,
 429 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 430 C<go> escapes the processing of the current request chain on completion, and
 431 does not return to its caller.
 432
 433 =cut
 434
 435 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 436
 437 =head2 $c->response
 438
 439 =head2 $c->res
 440
 441 Returns the current L<Catalyst::Response> object, see there for details.
 442
 443 =head2 $c->stash
 444
 445 Returns a hashref to the stash, which may be used to store data and pass
 446 it between components during a request. You can also set hash keys by
 447 passing arguments. The stash is automatically sent to the view. The
 448 stash is cleared at the end of a request; it cannot be used for
 449 persistent storage (for this you must use a session; see
 450 L<Catalyst::Plugin::Session> for a complete system integrated with
 451 Catalyst).
 452
 453     $c->stash->{foo} = $bar;
 454     $c->stash( { moose => 'majestic', qux => 0 } );
 455     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 456
 457     # stash is automatically passed to the view for use in a template
 458     $c->forward( 'MyApp::View::TT' );
 459
 460 =cut
 461
 462 around stash => sub {
 463     my $orig = shift;
 464     my $c = shift;
 465     my $stash = $orig->($c);
 466     if (@_) {
 467         my $new_stash = @_ > 1 ? {@_} : $_[0];
 468         croak('stash takes a hash or hashref') unless ref $new_stash;
 469         foreach my $key ( keys %$new_stash ) {
 470           $stash->{$key} = $new_stash->{$key};
 471         }
 472     }
 473
 474     return $stash;
 475 };
 476
 477
 478 =head2 $c->error
 479
 480 =head2 $c->error($error, ...)
 481
 482 =head2 $c->error($arrayref)
 483
 484 Returns an arrayref containing error messages.  If Catalyst encounters an
 485 error while processing a request, it stores the error in $c->error.  This
 486 method should only be used to store fatal error messages.
 487
 488     my @error = @{ $c->error };
 489
 490 Add a new error.
 491
 492     $c->error('Something bad happened');
 493
 494 =cut
 495
 496 sub error {
 497     my $c = shift;
 498     if ( $_[0] ) {
 499         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 500         croak @$error unless ref $c;
 501         push @{ $c->{error} }, @$error;
 502     }
 503     elsif ( defined $_[0] ) { $c->{error} = undef }
 504     return $c->{error} || [];
 505 }
 506
 507
 508 =head2 $c->state
 509
 510 Contains the return value of the last executed action.
 511 Note that << $c->state >> operates in a scalar context which means that all
 512 values it returns are scalar.
 513
 514 =head2 $c->clear_errors
 515
 516 Clear errors.  You probably don't want to clear the errors unless you are
 517 implementing a custom error screen.
 518
 519 This is equivalent to running
 520
 521     $c->error(0);
 522
 523 =cut
 524
 525 sub clear_errors {
 526     my $c = shift;
 527     $c->error(0);
 528 }
 529
 530 sub _comp_search_prefixes {
 531     my $c = shift;
 532     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
 533 }
 534
 535 # search components given a name and some prefixes
 536 sub _comp_names_search_prefixes {
 537     my ( $c, $name, @prefixes ) = @_;
 538     my $appclass = ref $c || $c;
 539     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 540     $filter = qr/$filter/; # Compile regex now rather than once per loop
 541
 542     # map the original component name to the sub part that we will search against
 543     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 544         grep { /$filter/ } keys %{ $c->components };
 545
 546     # undef for a name will return all
 547     return keys %eligible if !defined $name;
 548
 549     my $query  = ref $name ? $name : qr/^$name$/i;
 550     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 551
 552     return @result if @result;
 553
 554     # if we were given a regexp to search against, we're done.
 555     return if ref $name;
 556
 557     # skip regexp fallback if configured
 558     return
 559         if $appclass->config->{disable_component_resolution_regex_fallback};
 560
 561     # regexp fallback
 562     $query  = qr/$name/i;
 563     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 564
 565     # no results? try against full names
 566     if( !@result ) {
 567         @result = grep { m{$query} } keys %eligible;
 568     }
 569
 570     # don't warn if we didn't find any results, it just might not exist
 571     if( @result ) {
 572         # Disgusting hack to work out correct method name
 573         my $warn_for = lc $prefixes[0];
 574         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
 575            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
 576            "component resolution is unreliable and unsafe.";
 577         my $short = $result[0];
 578         # remove the component namespace prefix
 579         $short =~ s/.*?(Model|Controller|View):://;
 580         my $shortmess = Carp::shortmess('');
 581         if ($shortmess =~ m#Catalyst/Plugin#) {
 582            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 583               "plugin's config";
 584         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
 585            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 586               "component's config";
 587         } else {
 588            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
 589               "but if you really wanted to search, pass in a regexp as the argument " .
 590               "like so: \$c->${warn_for}(qr/${name}/)";
 591         }
 592         $c->log->warn( "${msg}$shortmess" );
 593     }
 594
 595     return @result;
 596 }
 597
 598 # Find possible names for a prefix
 599 sub _comp_names {
 600     my ( $c, @prefixes ) = @_;
 601     my $appclass = ref $c || $c;
 602
 603     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 604
 605     my @names = map { s{$filter}{}; $_; }
 606         $c->_comp_names_search_prefixes( undef, @prefixes );
 607
 608     return @names;
 609 }
 610
 611 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 612 sub _filter_component {
 613     my ( $c, $comp, @args ) = @_;
 614
 615     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 616         return $comp->ACCEPT_CONTEXT( $c, @args );
 617     }
 618
 619     return $comp;
 620 }
 621
 622 =head2 COMPONENT ACCESSORS
 623
 624 =head2 $c->controller($name)
 625
 626 Gets a L<Catalyst::Controller> instance by name.
 627
 628     $c->controller('Foo')->do_stuff;
 629
 630 If the name is omitted, will return the controller for the dispatched
 631 action.
 632
 633 If you want to search for controllers, pass in a regexp as the argument.
 634
 635     # find all controllers that start with Foo
 636     my @foo_controllers = $c->controller(qr{^Foo});
 637
 638
 639 =cut
 640
 641 sub controller {
 642     my ( $c, $name, @args ) = @_;
 643
 644     my $appclass = ref($c) || $c;
 645     if( $name ) {
 646         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
 647             my $comps = $c->components;
 648             my $check = $appclass."::Controller::".$name;
 649             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 650         }
 651         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
 652         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 653         return $c->_filter_component( $result[ 0 ], @args );
 654     }
 655
 656     return $c->component( $c->action->class );
 657 }
 658
 659 =head2 $c->model($name)
 660
 661 Gets a L<Catalyst::Model> instance by name.
 662
 663     $c->model('Foo')->do_stuff;
 664
 665 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 666
 667 If the name is omitted, it will look for
 668  - a model object in $c->stash->{current_model_instance}, then
 669  - a model name in $c->stash->{current_model}, then
 670  - a config setting 'default_model', or
 671  - check if there is only one model, and return it if that's the case.
 672
 673 If you want to search for models, pass in a regexp as the argument.
 674
 675     # find all models that start with Foo
 676     my @foo_models = $c->model(qr{^Foo});
 677
 678 =cut
 679
 680 sub model {
 681     my ( $c, $name, @args ) = @_;
 682     my $appclass = ref($c) || $c;
 683     if( $name ) {
 684         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
 685             my $comps = $c->components;
 686             my $check = $appclass."::Model::".$name;
 687             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 688         }
 689         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
 690         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 691         return $c->_filter_component( $result[ 0 ], @args );
 692     }
 693
 694     if (ref $c) {
 695         return $c->stash->{current_model_instance}
 696           if $c->stash->{current_model_instance};
 697         return $c->model( $c->stash->{current_model} )
 698           if $c->stash->{current_model};
 699     }
 700     return $c->model( $appclass->config->{default_model} )
 701       if $appclass->config->{default_model};
 702
 703     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
 704
 705     if( $rest ) {
 706         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
 707         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
 708         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 709         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 710         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 711     }
 712
 713     return $c->_filter_component( $comp );
 714 }
 715
 716
 717 =head2 $c->view($name)
 718
 719 Gets a L<Catalyst::View> instance by name.
 720
 721     $c->view('Foo')->do_stuff;
 722
 723 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 724
 725 If the name is omitted, it will look for
 726  - a view object in $c->stash->{current_view_instance}, then
 727  - a view name in $c->stash->{current_view}, then
 728  - a config setting 'default_view', or
 729  - check if there is only one view, and return it if that's the case.
 730
 731 If you want to search for views, pass in a regexp as the argument.
 732
 733     # find all views that start with Foo
 734     my @foo_views = $c->view(qr{^Foo});
 735
 736 =cut
 737
 738 sub view {
 739     my ( $c, $name, @args ) = @_;
 740
 741     my $appclass = ref($c) || $c;
 742     if( $name ) {
 743         unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
 744             my $comps = $c->components;
 745             my $check = $appclass."::View::".$name;
 746             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 747         }
 748         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
 749         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 750         return $c->_filter_component( $result[ 0 ], @args );
 751     }
 752
 753     if (ref $c) {
 754         return $c->stash->{current_view_instance}
 755           if $c->stash->{current_view_instance};
 756         return $c->view( $c->stash->{current_view} )
 757           if $c->stash->{current_view};
 758     }
 759     return $c->view( $appclass->config->{default_view} )
 760       if $appclass->config->{default_view};
 761
 762     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
 763
 764     if( $rest ) {
 765         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 766         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
 767         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 768         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 769         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 770     }
 771
 772     return $c->_filter_component( $comp );
 773 }
 774
 775 =head2 $c->controllers
 776
 777 Returns the available names which can be passed to $c->controller
 778
 779 =cut
 780
 781 sub controllers {
 782     my ( $c ) = @_;
 783     return $c->_comp_names(qw/Controller C/);
 784 }
 785
 786 =head2 $c->models
 787
 788 Returns the available names which can be passed to $c->model
 789
 790 =cut
 791
 792 sub models {
 793     my ( $c ) = @_;
 794     return $c->_comp_names(qw/Model M/);
 795 }
 796
 797
 798 =head2 $c->views
 799
 800 Returns the available names which can be passed to $c->view
 801
 802 =cut
 803
 804 sub views {
 805     my ( $c ) = @_;
 806     return $c->_comp_names(qw/View V/);
 807 }
 808
 809 =head2 $c->comp($name)
 810
 811 =head2 $c->component($name)
 812
 813 Gets a component object by name. This method is not recommended,
 814 unless you want to get a specific component by full
 815 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 816 should be used instead.
 817
 818 If C<$name> is a regexp, a list of components matched against the full
 819 component name will be returned.
 820
 821 If Catalyst can't find a component by name, it will fallback to regex
 822 matching by default. To disable this behaviour set
 823 disable_component_resolution_regex_fallback to a true value.
 824
 825     __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
 826
 827 =cut
 828
 829 sub component {
 830     my ( $c, $name, @args ) = @_;
 831
 832     if( $name ) {
 833         my $comps = $c->components;
 834
 835         if( !ref $name ) {
 836             # is it the exact name?
 837             return $c->_filter_component( $comps->{ $name }, @args )
 838                        if exists $comps->{ $name };
 839
 840             # perhaps we just omitted "MyApp"?
 841             my $composed = ( ref $c || $c ) . "::${name}";
 842             return $c->_filter_component( $comps->{ $composed }, @args )
 843                        if exists $comps->{ $composed };
 844
 845             # search all of the models, views and controllers
 846             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
 847             return $c->_filter_component( $comp, @args ) if $comp;
 848         }
 849
 850         # This is here so $c->comp( '::M::' ) works
 851         my $query = ref $name ? $name : qr{$name}i;
 852
 853         my @result = grep { m{$query} } keys %{ $c->components };
 854         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 855
 856         if( $result[ 0 ] ) {
 857             $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 858             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 859             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 860             return $c->_filter_component( $result[ 0 ], @args );
 861         }
 862
 863         # I would expect to return an empty list here, but that breaks back-compat
 864     }
 865
 866     # fallback
 867     return sort keys %{ $c->components };
 868 }
 869
 870 =head2 CLASS DATA AND HELPER CLASSES
 871
 872 =head2 $c->config
 873
 874 Returns or takes a hashref containing the application's configuration.
 875
 876     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 877
 878 You can also use a C<YAML>, C<XML> or L<Config::General> config file
 879 like C<myapp.conf> in your applications home directory. See
 880 L<Catalyst::Plugin::ConfigLoader>.
 881
 882 =head3 Cascading configuration
 883
 884 The config method is present on all Catalyst components, and configuration
 885 will be merged when an application is started. Configuration loaded with
 886 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
 887 followed by configuration in your top level C<MyApp> class. These two
 888 configurations are merged, and then configuration data whose hash key matches a
 889 component name is merged with configuration for that component.
 890
 891 The configuration for a component is then passed to the C<new> method when a
 892 component is constructed.
 893
 894 For example:
 895
 896     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
 897     MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
 898
 899 will mean that C<MyApp::Model::Foo> receives the following data when
 900 constructed:
 901
 902     MyApp::Model::Foo->new({
 903         bar => 'baz',
 904         quux => 'frob',
 905         overrides => 'me',
 906     });
 907
 908 =cut
 909
 910 around config => sub {
 911     my $orig = shift;
 912     my $c = shift;
 913
 914     croak('Setting config after setup has been run is not allowed.')
 915         if ( @_ and $c->setup_finished );
 916
 917     $c->$orig(@_);
 918 };
 919
 920 =head2 $c->log
 921
 922 Returns the logging object instance. Unless it is already set, Catalyst
 923 sets this up with a L<Catalyst::Log> object. To use your own log class,
 924 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 925 C<< __PACKAGE__->setup >>.
 926
 927  __PACKAGE__->log( MyLogger->new );
 928  __PACKAGE__->setup;
 929
 930 And later:
 931
 932     $c->log->info( 'Now logging with my own logger!' );
 933
 934 Your log class should implement the methods described in
 935 L<Catalyst::Log>.
 936
 937
 938 =head2 $c->debug
 939
 940 Returns 1 if debug mode is enabled, 0 otherwise.
 941
 942 You can enable debug mode in several ways:
 943
 944 =over
 945
 946 =item By calling myapp_server.pl with the -d flag
 947
 948 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
 949
 950 =item The -Debug option in your MyApp.pm
 951
 952 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
 953
 954 =back
 955
 956 The first three also set the log level to 'debug'.
 957
 958 Calling C<< $c->debug(1) >> has no effect.
 959
 960 =cut
 961
 962 sub debug { 0 }
 963
 964 =head2 $c->dispatcher
 965
 966 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
 967
 968 =head2 $c->engine
 969
 970 Returns the engine instance. See L<Catalyst::Engine>.
 971
 972
 973 =head2 UTILITY METHODS
 974
 975 =head2 $c->path_to(@path)
 976
 977 Merges C<@path> with C<< $c->config->{home} >> and returns a
 978 L<Path::Class::Dir> object. Note you can usually use this object as
 979 a filename, but sometimes you will have to explicitly stringify it
 980 yourself by calling the C<< ->stringify >> method.
 981
 982 For example:
 983
 984     $c->path_to( 'db', 'sqlite.db' );
 985
 986 =cut
 987
 988 sub path_to {
 989     my ( $c, @path ) = @_;
 990     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 991     if ( -d $path ) { return $path }
 992     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 993 }
 994
 995 =head2 $c->plugin( $name, $class, @args )
 996
 997 Helper method for plugins. It creates a class data accessor/mutator and
 998 loads and instantiates the given class.
 999
1000     MyApp->plugin( 'prototype', 'HTML::Prototype' );
1001
1002     $c->prototype->define_javascript_functions;
1003
1004 B<Note:> This method of adding plugins is deprecated. The ability
1005 to add plugins like this B<will be removed> in a Catalyst 5.81.
1006 Please do not use this functionality in new code.
1007
1008 =cut
1009
1010 sub plugin {
1011     my ( $class, $name, $plugin, @args ) = @_;
1012
1013     # See block comment in t/unit_core_plugin.t
1014     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
1015
1016     $class->_register_plugin( $plugin, 1 );
1017
1018     eval { $plugin->import };
1019     $class->mk_classdata($name);
1020     my $obj;
1021     eval { $obj = $plugin->new(@args) };
1022
1023     if ($@) {
1024         Catalyst::Exception->throw( message =>
1025               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1026     }
1027
1028     $class->$name($obj);
1029     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1030       if $class->debug;
1031 }
1032
1033 =head2 MyApp->setup
1034
1035 Initializes the dispatcher and engine, loads any plugins, and loads the
1036 model, view, and controller components. You may also specify an array
1037 of plugins to load here, if you choose to not load them in the C<use
1038 Catalyst> line.
1039
1040     MyApp->setup;
1041     MyApp->setup( qw/-Debug/ );
1042
1043 =cut
1044
1045 sub setup {
1046     my ( $class, @arguments ) = @_;
1047     croak('Running setup more than once')
1048         if ( $class->setup_finished );
1049
1050     unless ( $class->isa('Catalyst') ) {
1051
1052         Catalyst::Exception->throw(
1053             message => qq/'$class' does not inherit from Catalyst/ );
1054     }
1055
1056     if ( $class->arguments ) {
1057         @arguments = ( @arguments, @{ $class->arguments } );
1058     }
1059
1060     # Process options
1061     my $flags = {};
1062
1063     foreach (@arguments) {
1064
1065         if (/^-Debug$/) {
1066             $flags->{log} =
1067               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1068         }
1069         elsif (/^-(\w+)=?(.*)$/) {
1070             $flags->{ lc $1 } = $2;
1071         }
1072         else {
1073             push @{ $flags->{plugins} }, $_;
1074         }
1075     }
1076
1077     $class->setup_home( delete $flags->{home} );
1078
1079     $class->setup_log( delete $flags->{log} );
1080     $class->setup_plugins( delete $flags->{plugins} );
1081     $class->setup_dispatcher( delete $flags->{dispatcher} );
1082     $class->setup_engine( delete $flags->{engine} );
1083     $class->setup_stats( delete $flags->{stats} );
1084
1085     for my $flag ( sort keys %{$flags} ) {
1086
1087         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1088             &$code( $class, delete $flags->{$flag} );
1089         }
1090         else {
1091             $class->log->warn(qq/Unknown flag "$flag"/);
1092         }
1093     }
1094
1095     eval { require Catalyst::Devel; };
1096     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1097         $class->log->warn(<<"EOF");
1098 You are running an old script!
1099
1100   Please update by running (this will overwrite existing files):
1101     catalyst.pl -force -scripts $class
1102
1103   or (this will not overwrite existing files):
1104     catalyst.pl -scripts $class
1105
1106 EOF
1107     }
1108
1109     if ( $class->debug ) {
1110         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1111
1112         if (@plugins) {
1113             my $column_width = Catalyst::Utils::term_width() - 6;
1114             my $t = Text::SimpleTable->new($column_width);
1115             $t->row($_) for @plugins;
1116             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1117         }
1118
1119         my $dispatcher = $class->dispatcher;
1120         my $engine     = $class->engine;
1121         my $home       = $class->config->{home};
1122
1123         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1124         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1125
1126         $home
1127           ? ( -d $home )
1128           ? $class->log->debug(qq/Found home "$home"/)
1129           : $class->log->debug(qq/Home "$home" doesn't exist/)
1130           : $class->log->debug(q/Couldn't find home/);
1131     }
1132
1133     # Call plugins setup, this is stupid and evil.
1134     # Also screws C3 badly on 5.10, hack to avoid.
1135     {
1136         no warnings qw/redefine/;
1137         local *setup = sub { };
1138         $class->setup unless $Catalyst::__AM_RESTARTING;
1139     }
1140
1141     # Initialize our data structure
1142     $class->components( {} );
1143
1144     $class->setup_components;
1145
1146     if ( $class->debug ) {
1147         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1148         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1149         for my $comp ( sort keys %{ $class->components } ) {
1150             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1151             $t->row( $comp, $type );
1152         }
1153         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1154           if ( keys %{ $class->components } );
1155     }
1156
1157     # Add our self to components, since we are also a component
1158     if( $class->isa('Catalyst::Controller') ){
1159       $class->components->{$class} = $class;
1160     }
1161
1162     $class->setup_actions;
1163
1164     if ( $class->debug ) {
1165         my $name = $class->config->{name} || 'Application';
1166         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1167     }
1168
1169     # Make sure that the application class becomes immutable at this point,
1170     B::Hooks::EndOfScope::on_scope_end {
1171         return if $@;
1172         my $meta = Class::MOP::get_metaclass_by_name($class);
1173         if (
1174             $meta->is_immutable
1175             && ! { $meta->immutable_options }->{replace_constructor}
1176             && (
1177                    $class->isa('Class::Accessor::Fast')
1178                 || $class->isa('Class::Accessor')
1179             )
1180         ) {
1181             warn "You made your application class ($class) immutable, "
1182                 . "but did not inline the\nconstructor. "
1183                 . "This will break catalyst, as your app \@ISA "
1184                 . "Class::Accessor(::Fast)?\nPlease pass "
1185                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1186         }
1187         $meta->make_immutable(
1188             replace_constructor => 1,
1189         ) unless $meta->is_immutable;
1190     };
1191
1192     if ($class->config->{case_sensitive}) {
1193         $class->log->warn($class . "->config->{case_sensitive} is set.");
1194         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1195     }
1196
1197     $class->setup_finalize;
1198     # Should be the last thing we do so that user things hooking
1199     # setup_finalize can log..
1200     $class->log->_flush() if $class->log->can('_flush');
1201     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
1202 }
1203
1204 =head2 $app->setup_finalize
1205
1206 A hook to attach modifiers to. This method does not do anything except set the
1207 C<setup_finished> accessor.
1208
1209 Applying method modifiers to the C<setup> method doesn't work, because of quirky thingsdone for plugin setup.
1210
1211 Example:
1212
1213     after setup_finalize => sub {
1214         my $app = shift;
1215
1216         ## do stuff here..
1217     };
1218
1219 =cut
1220
1221 sub setup_finalize {
1222     my ($class) = @_;
1223     $class->setup_finished(1);
1224 }
1225
1226 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1227
1228 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1229
1230 Constructs an absolute L<URI> object based on the application root, the
1231 provided path, and the additional arguments and query parameters provided.
1232 When used as a string, provides a textual URI.
1233
1234 If no arguments are provided, the URI for the current action is returned.
1235 To return the current action and also provide @args, use
1236 C<< $c->uri_for( $c->action, @args ) >>.
1237
1238 If the first argument is a string, it is taken as a public URI path relative
1239 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1240 relative to the application root (if it does). It is then merged with
1241 C<< $c->request->base >>; any C<@args> are appended as additional path
1242 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1243
1244 If the first argument is a L<Catalyst::Action> it represents an action which
1245 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1246 optional C<\@captures> argument (an arrayref) allows passing the captured
1247 variables that are needed to fill in the paths of Chained and Regex actions;
1248 once the path is resolved, C<uri_for> continues as though a path was
1249 provided, appending any arguments or parameters and creating an absolute
1250 URI.
1251
1252 The captures for the current request can be found in
1253 C<< $c->request->captures >>, and actions can be resolved using
1254 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1255 path, use C<< $c->uri_for_action >> instead.
1256
1257   # Equivalent to $c->req->uri
1258   $c->uri_for($c->action, $c->req->captures,
1259       @{ $c->req->args }, $c->req->params);
1260
1261   # For the Foo action in the Bar controller
1262   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1263
1264   # Path to a static resource
1265   $c->uri_for('/static/images/logo.png');
1266
1267 =cut
1268
1269 sub uri_for {
1270     my ( $c, $path, @args ) = @_;
1271
1272     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1273         $path = $path->path_prefix;
1274         $path =~ s{/+\z}{};
1275         $path .= '/';
1276     }
1277
1278     undef($path) if (defined $path && $path eq '');
1279
1280     my $params =
1281       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1282
1283     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1284     foreach my $arg (@args) {
1285         utf8::encode($arg) if utf8::is_utf8($arg);
1286         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1287     }
1288
1289     if ( blessed($path) ) { # action object
1290         s|/|%2F|g for @args;
1291         my $captures = [ map { s|/|%2F|g; $_; }
1292                         ( scalar @args && ref $args[0] eq 'ARRAY'
1293                          ? @{ shift(@args) }
1294                          : ()) ];
1295
1296         foreach my $capture (@$captures) {
1297             utf8::encode($capture) if utf8::is_utf8($capture);
1298             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1299         }
1300
1301         my $action = $path;
1302         $path = $c->dispatcher->uri_for_action($action, $captures);
1303         if (not defined $path) {
1304             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1305                 if $c->debug;
1306             return undef;
1307         }
1308         $path = '/' if $path eq '';
1309     }
1310
1311     unshift(@args, $path);
1312
1313     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1314         my $namespace = $c->namespace;
1315         if (defined $path) { # cheesy hack to handle path '../foo'
1316            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1317         }
1318         unshift(@args, $namespace || '');
1319     }
1320
1321     # join args with '/', or a blank string
1322     my $args = join('/', grep { defined($_) } @args);
1323     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1324     $args =~ s!^/+!!;
1325     my $base = $c->req->base;
1326     my $class = ref($base);
1327     $base =~ s{(?<!/)$}{/};
1328
1329     my $query = '';
1330
1331     if (my @keys = keys %$params) {
1332       # somewhat lifted from URI::_query's query_form
1333       $query = '?'.join('&', map {
1334           my $val = $params->{$_};
1335           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1336           s/ /+/g;
1337           my $key = $_;
1338           $val = '' unless defined $val;
1339           (map {
1340               my $param = "$_";
1341               utf8::encode( $param ) if utf8::is_utf8($param);
1342               # using the URI::Escape pattern here so utf8 chars survive
1343               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1344               $param =~ s/ /+/g;
1345               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1346       } @keys);
1347     }
1348
1349     my $res = bless(\"${base}${args}${query}", $class);
1350     $res;
1351 }
1352
1353 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1354
1355 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1356
1357 =over
1358
1359 =item $path
1360
1361 A private path to the Catalyst action you want to create a URI for.
1362
1363 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1364 >> and passing the resulting C<$action> and the remaining arguments to C<<
1365 $c->uri_for >>.
1366
1367 You can also pass in a Catalyst::Action object, in which case it is passed to
1368 C<< $c->uri_for >>.
1369
1370 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.
1371
1372 For example, if the action looks like:
1373
1374  package MyApp::Controller::Users;
1375
1376  sub lst : Path('the-list') {}
1377
1378 You can use:
1379
1380  $c->uri_for_action('/users/lst')
1381
1382 and it will create the URI /users/the-list.
1383
1384 =back
1385
1386 =cut
1387
1388 sub uri_for_action {
1389     my ( $c, $path, @args ) = @_;
1390     my $action = blessed($path)
1391       ? $path
1392       : $c->dispatcher->get_action_by_path($path);
1393     unless (defined $action) {
1394       croak "Can't find action for path '$path'";
1395     }
1396     return $c->uri_for( $action, @args );
1397 }
1398
1399 =head2 $c->welcome_message
1400
1401 Returns the Catalyst welcome HTML page.
1402
1403 =cut
1404
1405 sub welcome_message {
1406     my $c      = shift;
1407     my $name   = $c->config->{name};
1408     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1409     my $prefix = Catalyst::Utils::appprefix( ref $c );
1410     $c->response->content_type('text/html; charset=utf-8');
1411     return <<"EOF";
1412 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1413     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1414 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1415     <head>
1416     <meta http-equiv="Content-Language" content="en" />
1417     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1418         <title>$name on Catalyst $VERSION</title>
1419         <style type="text/css">
1420             body {
1421                 color: #000;
1422                 background-color: #eee;
1423             }
1424             div#content {
1425                 width: 640px;
1426                 margin-left: auto;
1427                 margin-right: auto;
1428                 margin-top: 10px;
1429                 margin-bottom: 10px;
1430                 text-align: left;
1431                 background-color: #ccc;
1432                 border: 1px solid #aaa;
1433             }
1434             p, h1, h2 {
1435                 margin-left: 20px;
1436                 margin-right: 20px;
1437                 font-family: verdana, tahoma, sans-serif;
1438             }
1439             a {
1440                 font-family: verdana, tahoma, sans-serif;
1441             }
1442             :link, :visited {
1443                     text-decoration: none;
1444                     color: #b00;
1445                     border-bottom: 1px dotted #bbb;
1446             }
1447             :link:hover, :visited:hover {
1448                     color: #555;
1449             }
1450             div#topbar {
1451                 margin: 0px;
1452             }
1453             pre {
1454                 margin: 10px;
1455                 padding: 8px;
1456             }
1457             div#answers {
1458                 padding: 8px;
1459                 margin: 10px;
1460                 background-color: #fff;
1461                 border: 1px solid #aaa;
1462             }
1463             h1 {
1464                 font-size: 0.9em;
1465                 font-weight: normal;
1466                 text-align: center;
1467             }
1468             h2 {
1469                 font-size: 1.0em;
1470             }
1471             p {
1472                 font-size: 0.9em;
1473             }
1474             p img {
1475                 float: right;
1476                 margin-left: 10px;
1477             }
1478             span#appname {
1479                 font-weight: bold;
1480                 font-size: 1.6em;
1481             }
1482         </style>
1483     </head>
1484     <body>
1485         <div id="content">
1486             <div id="topbar">
1487                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1488                     $VERSION</h1>
1489              </div>
1490              <div id="answers">
1491                  <p>
1492                  <img src="$logo" alt="Catalyst Logo" />
1493                  </p>
1494                  <p>Welcome to the  world of Catalyst.
1495                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1496                     framework will make web development something you had
1497                     never expected it to be: Fun, rewarding, and quick.</p>
1498                  <h2>What to do now?</h2>
1499                  <p>That really depends  on what <b>you</b> want to do.
1500                     We do, however, provide you with a few starting points.</p>
1501                  <p>If you want to jump right into web development with Catalyst
1502                     you might want to start with a tutorial.</p>
1503 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1504 </pre>
1505 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1506 <pre>
1507 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1508 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1509 </code></pre>
1510                  <h2>What to do next?</h2>
1511                  <p>Next it's time to write an actual application. Use the
1512                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1513                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1514                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1515                     they can save you a lot of work.</p>
1516                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1517                     <p>Also, be sure to check out the vast and growing
1518                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1519                     you are likely to find what you need there.
1520                     </p>
1521
1522                  <h2>Need help?</h2>
1523                  <p>Catalyst has a very active community. Here are the main places to
1524                     get in touch with us.</p>
1525                  <ul>
1526                      <li>
1527                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1528                      </li>
1529                      <li>
1530                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1531                      </li>
1532                      <li>
1533                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1534                      </li>
1535                  </ul>
1536                  <h2>In conclusion</h2>
1537                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1538                     as we enjoyed making it. Please contact us if you have ideas
1539                     for improvement or other feedback.</p>
1540              </div>
1541          </div>
1542     </body>
1543 </html>
1544 EOF
1545 }
1546
1547 =head1 INTERNAL METHODS
1548
1549 These methods are not meant to be used by end users.
1550
1551 =head2 $c->components
1552
1553 Returns a hash of components.
1554
1555 =head2 $c->context_class
1556
1557 Returns or sets the context class.
1558
1559 =head2 $c->counter
1560
1561 Returns a hashref containing coderefs and execution counts (needed for
1562 deep recursion detection).
1563
1564 =head2 $c->depth
1565
1566 Returns the number of actions on the current internal execution stack.
1567
1568 =head2 $c->dispatch
1569
1570 Dispatches a request to actions.
1571
1572 =cut
1573
1574 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1575
1576 =head2 $c->dispatcher_class
1577
1578 Returns or sets the dispatcher class.
1579
1580 =head2 $c->dump_these
1581
1582 Returns a list of 2-element array references (name, structure) pairs
1583 that will be dumped on the error page in debug mode.
1584
1585 =cut
1586
1587 sub dump_these {
1588     my $c = shift;
1589     [ Request => $c->req ],
1590     [ Response => $c->res ],
1591     [ Stash => $c->stash ],
1592     [ Config => $c->config ];
1593 }
1594
1595 =head2 $c->engine_class
1596
1597 Returns or sets the engine class.
1598
1599 =head2 $c->execute( $class, $coderef )
1600
1601 Execute a coderef in given class and catch exceptions. Errors are available
1602 via $c->error.
1603
1604 =cut
1605
1606 sub execute {
1607     my ( $c, $class, $code ) = @_;
1608     $class = $c->component($class) || $class;
1609     $c->state(0);
1610
1611     if ( $c->depth >= $RECURSION ) {
1612         my $action = $code->reverse();
1613         $action = "/$action" unless $action =~ /->/;
1614         my $error = qq/Deep recursion detected calling "${action}"/;
1615         $c->log->error($error);
1616         $c->error($error);
1617         $c->state(0);
1618         return $c->state;
1619     }
1620
1621     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1622
1623     push( @{ $c->stack }, $code );
1624
1625     no warnings 'recursion';
1626     eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1627
1628     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1629
1630     my $last = pop( @{ $c->stack } );
1631
1632     if ( my $error = $@ ) {
1633         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1634             $error->rethrow if $c->depth > 1;
1635         }
1636         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1637             $error->rethrow if $c->depth > 0;
1638         }
1639         else {
1640             unless ( ref $error ) {
1641                 no warnings 'uninitialized';
1642                 chomp $error;
1643                 my $class = $last->class;
1644                 my $name  = $last->name;
1645                 $error = qq/Caught exception in $class->$name "$error"/;
1646             }
1647             $c->error($error);
1648             $c->state(0);
1649         }
1650     }
1651     return $c->state;
1652 }
1653
1654 sub _stats_start_execute {
1655     my ( $c, $code ) = @_;
1656     my $appclass = ref($c) || $c;
1657     return if ( ( $code->name =~ /^_.*/ )
1658         && ( !$appclass->config->{show_internal_actions} ) );
1659
1660     my $action_name = $code->reverse();
1661     $c->counter->{$action_name}++;
1662
1663     my $action = $action_name;
1664     $action = "/$action" unless $action =~ /->/;
1665
1666     # determine if the call was the result of a forward
1667     # this is done by walking up the call stack and looking for a calling
1668     # sub of Catalyst::forward before the eval
1669     my $callsub = q{};
1670     for my $index ( 2 .. 11 ) {
1671         last
1672         if ( ( caller($index) )[0] eq 'Catalyst'
1673             && ( caller($index) )[3] eq '(eval)' );
1674
1675         if ( ( caller($index) )[3] =~ /forward$/ ) {
1676             $callsub = ( caller($index) )[3];
1677             $action  = "-> $action";
1678             last;
1679         }
1680     }
1681
1682     my $uid = $action_name . $c->counter->{$action_name};
1683
1684     # is this a root-level call or a forwarded call?
1685     if ( $callsub =~ /forward$/ ) {
1686         my $parent = $c->stack->[-1];
1687
1688         # forward, locate the caller
1689         if ( exists $c->counter->{"$parent"} ) {
1690             $c->stats->profile(
1691                 begin  => $action,
1692                 parent => "$parent" . $c->counter->{"$parent"},
1693                 uid    => $uid,
1694             );
1695         }
1696         else {
1697
1698             # forward with no caller may come from a plugin
1699             $c->stats->profile(
1700                 begin => $action,
1701                 uid   => $uid,
1702             );
1703         }
1704     }
1705     else {
1706
1707         # root-level call
1708         $c->stats->profile(
1709             begin => $action,
1710             uid   => $uid,
1711         );
1712     }
1713     return $action;
1714
1715 }
1716
1717 sub _stats_finish_execute {
1718     my ( $c, $info ) = @_;
1719     $c->stats->profile( end => $info );
1720 }
1721
1722 =head2 $c->finalize
1723
1724 Finalizes the request.
1725
1726 =cut
1727
1728 sub finalize {
1729     my $c = shift;
1730
1731     for my $error ( @{ $c->error } ) {
1732         $c->log->error($error);
1733     }
1734
1735     # Allow engine to handle finalize flow (for POE)
1736     my $engine = $c->engine;
1737     if ( my $code = $engine->can('finalize') ) {
1738         $engine->$code($c);
1739     }
1740     else {
1741
1742         $c->finalize_uploads;
1743
1744         # Error
1745         if ( $#{ $c->error } >= 0 ) {
1746             $c->finalize_error;
1747         }
1748
1749         $c->finalize_headers;
1750
1751         # HEAD request
1752         if ( $c->request->method eq 'HEAD' ) {
1753             $c->response->body('');
1754         }
1755
1756         $c->finalize_body;
1757     }
1758
1759     $c->log_response;
1760
1761     if ($c->use_stats) {
1762         my $elapsed = sprintf '%f', $c->stats->elapsed;
1763         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1764         $c->log->info(
1765             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1766     }
1767
1768     return $c->response->status;
1769 }
1770
1771 =head2 $c->finalize_body
1772
1773 Finalizes body.
1774
1775 =cut
1776
1777 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1778
1779 =head2 $c->finalize_cookies
1780
1781 Finalizes cookies.
1782
1783 =cut
1784
1785 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1786
1787 =head2 $c->finalize_error
1788
1789 Finalizes error.
1790
1791 =cut
1792
1793 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1794
1795 =head2 $c->finalize_headers
1796
1797 Finalizes headers.
1798
1799 =cut
1800
1801 sub finalize_headers {
1802     my $c = shift;
1803
1804     my $response = $c->response; #accessor calls can add up?
1805
1806     # Check if we already finalized headers
1807     return if $response->finalized_headers;
1808
1809     # Handle redirects
1810     if ( my $location = $response->redirect ) {
1811         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1812         $response->header( Location => $location );
1813
1814         if ( !$response->has_body ) {
1815             # Add a default body if none is already present
1816             $response->body(
1817                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1818             );
1819         }
1820     }
1821
1822     # Content-Length
1823     if ( $response->body && !$response->content_length ) {
1824
1825         # get the length from a filehandle
1826         if ( blessed( $response->body ) && $response->body->can('read') )
1827         {
1828             my $stat = stat $response->body;
1829             if ( $stat && $stat->size > 0 ) {
1830                 $response->content_length( $stat->size );
1831             }
1832             else {
1833                 $c->log->warn('Serving filehandle without a content-length');
1834             }
1835         }
1836         else {
1837             # everything should be bytes at this point, but just in case
1838             $response->content_length( length( $response->body ) );
1839         }
1840     }
1841
1842     # Errors
1843     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1844         $response->headers->remove_header("Content-Length");
1845         $response->body('');
1846     }
1847
1848     $c->finalize_cookies;
1849
1850     $c->engine->finalize_headers( $c, @_ );
1851
1852     # Done
1853     $response->finalized_headers(1);
1854 }
1855
1856 =head2 $c->finalize_output
1857
1858 An alias for finalize_body.
1859
1860 =head2 $c->finalize_read
1861
1862 Finalizes the input after reading is complete.
1863
1864 =cut
1865
1866 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1867
1868 =head2 $c->finalize_uploads
1869
1870 Finalizes uploads. Cleans up any temporary files.
1871
1872 =cut
1873
1874 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1875
1876 =head2 $c->get_action( $action, $namespace )
1877
1878 Gets an action in a given namespace.
1879
1880 =cut
1881
1882 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1883
1884 =head2 $c->get_actions( $action, $namespace )
1885
1886 Gets all actions of a given name in a namespace and all parent
1887 namespaces.
1888
1889 =cut
1890
1891 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1892
1893 =head2 $app->handle_request( @arguments )
1894
1895 Called to handle each HTTP request.
1896
1897 =cut
1898
1899 sub handle_request {
1900     my ( $class, @arguments ) = @_;
1901
1902     # Always expect worst case!
1903     my $status = -1;
1904     try {
1905         if ($class->debug) {
1906             my $secs = time - $START || 1;
1907             my $av = sprintf '%.3f', $COUNT / $secs;
1908             my $time = localtime time;
1909             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1910         }
1911
1912         my $c = $class->prepare(@arguments);
1913         $c->dispatch;
1914         $status = $c->finalize;
1915     }
1916     catch {
1917         chomp(my $error = $_);
1918         $class->log->error(qq/Caught exception in engine "$error"/);
1919     };
1920
1921     $COUNT++;
1922
1923     if(my $coderef = $class->log->can('_flush')){
1924         $class->log->$coderef();
1925     }
1926     return $status;
1927 }
1928
1929 =head2 $c->prepare( @arguments )
1930
1931 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1932 etc.).
1933
1934 =cut
1935
1936 sub prepare {
1937     my ( $class, @arguments ) = @_;
1938
1939     # XXX
1940     # After the app/ctxt split, this should become an attribute based on something passed
1941     # into the application.
1942     $class->context_class( ref $class || $class ) unless $class->context_class;
1943
1944     my $c = $class->context_class->new({});
1945
1946     # For on-demand data
1947     $c->request->_context($c);
1948     $c->response->_context($c);
1949
1950     #surely this is not the most efficient way to do things...
1951     $c->stats($class->stats_class->new)->enable($c->use_stats);
1952     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
1953         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1954     }
1955
1956     try {
1957         # Allow engine to direct the prepare flow (for POE)
1958         if ( my $prepare = $c->engine->can('prepare') ) {
1959             $c->engine->$prepare( $c, @arguments );
1960         }
1961         else {
1962             $c->prepare_request(@arguments);
1963             $c->prepare_connection;
1964             $c->prepare_query_parameters;
1965             $c->prepare_headers;
1966             $c->prepare_cookies;
1967             $c->prepare_path;
1968
1969             # Prepare the body for reading, either by prepare_body
1970             # or the user, if they are using $c->read
1971             $c->prepare_read;
1972
1973             # Parse the body unless the user wants it on-demand
1974             unless ( ref($c)->config->{parse_on_demand} ) {
1975                 $c->prepare_body;
1976             }
1977         }
1978     }
1979     # VERY ugly and probably shouldn't rely on ->finalize actually working
1980     catch {
1981         # failed prepare is always due to an invalid request, right?
1982         $c->response->status(400);
1983         $c->response->content_type('text/plain');
1984         $c->response->body('Bad Request');
1985         $c->finalize;
1986         die $_;
1987     };
1988
1989     my $method  = $c->req->method  || '';
1990     my $path    = $c->req->path;
1991     $path       = '/' unless length $path;
1992     my $address = $c->req->address || '';
1993
1994     $c->log_request;
1995
1996     $c->prepare_action;
1997
1998     return $c;
1999 }
2000
2001 =head2 $c->prepare_action
2002
2003 Prepares action. See L<Catalyst::Dispatcher>.
2004
2005 =cut
2006
2007 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
2008
2009 =head2 $c->prepare_body
2010
2011 Prepares message body.
2012
2013 =cut
2014
2015 sub prepare_body {
2016     my $c = shift;
2017
2018     return if $c->request->_has_body;
2019
2020     # Initialize on-demand data
2021     $c->engine->prepare_body( $c, @_ );
2022     $c->prepare_parameters;
2023     $c->prepare_uploads;
2024 }
2025
2026 =head2 $c->prepare_body_chunk( $chunk )
2027
2028 Prepares a chunk of data before sending it to L<HTTP::Body>.
2029
2030 See L<Catalyst::Engine>.
2031
2032 =cut
2033
2034 sub prepare_body_chunk {
2035     my $c = shift;
2036     $c->engine->prepare_body_chunk( $c, @_ );
2037 }
2038
2039 =head2 $c->prepare_body_parameters
2040
2041 Prepares body parameters.
2042
2043 =cut
2044
2045 sub prepare_body_parameters {
2046     my $c = shift;
2047     $c->engine->prepare_body_parameters( $c, @_ );
2048 }
2049
2050 =head2 $c->prepare_connection
2051
2052 Prepares connection.
2053
2054 =cut
2055
2056 sub prepare_connection {
2057     my $c = shift;
2058     $c->engine->prepare_connection( $c, @_ );
2059 }
2060
2061 =head2 $c->prepare_cookies
2062
2063 Prepares cookies.
2064
2065 =cut
2066
2067 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
2068
2069 =head2 $c->prepare_headers
2070
2071 Prepares headers.
2072
2073 =cut
2074
2075 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
2076
2077 =head2 $c->prepare_parameters
2078
2079 Prepares parameters.
2080
2081 =cut
2082
2083 sub prepare_parameters {
2084     my $c = shift;
2085     $c->prepare_body_parameters;
2086     $c->engine->prepare_parameters( $c, @_ );
2087 }
2088
2089 =head2 $c->prepare_path
2090
2091 Prepares path and base.
2092
2093 =cut
2094
2095 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2096
2097 =head2 $c->prepare_query_parameters
2098
2099 Prepares query parameters.
2100
2101 =cut
2102
2103 sub prepare_query_parameters {
2104     my $c = shift;
2105
2106     $c->engine->prepare_query_parameters( $c, @_ );
2107 }
2108
2109 =head2 $c->log_request
2110
2111 Writes information about the request to the debug logs.  This includes:
2112
2113 =over 4
2114
2115 =item * Request method, path, and remote IP address
2116
2117 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2118
2119 =item * Request parameters
2120
2121 =item * File uploads
2122
2123 =back
2124
2125 =cut
2126
2127 sub log_request {
2128     my $c = shift;
2129
2130     return unless $c->debug;
2131
2132     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2133     my $request = $dump->[1];
2134
2135     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2136     $method ||= '';
2137     $path = '/' unless length $path;
2138     $address ||= '';
2139     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2140
2141     $c->log_request_headers($request->headers);
2142
2143     if ( my $keywords = $request->query_keywords ) {
2144         $c->log->debug("Query keywords are: $keywords");
2145     }
2146
2147     $c->log_request_parameters( query => $request->query_parameters, body => $request->body_parameters );
2148
2149     $c->log_request_uploads($request);
2150 }
2151
2152 =head2 $c->log_response
2153
2154 Writes information about the response to the debug logs by calling
2155 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2156
2157 =cut
2158
2159 sub log_response {
2160     my $c = shift;
2161
2162     return unless $c->debug;
2163
2164     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2165     my $response = $dump->[1];
2166
2167     $c->log_response_status_line($response);
2168     $c->log_response_headers($response->headers);
2169 }
2170
2171 =head2 $c->log_response_status_line($response)
2172
2173 Writes one line of information about the response to the debug logs.  This includes:
2174
2175 =over 4
2176
2177 =item * Response status code
2178
2179 =item * Content-Type header (if present)
2180
2181 =item * Content-Length header (if present)
2182
2183 =back
2184
2185 =cut
2186
2187 sub log_response_status_line {
2188     my ($c, $response) = @_;
2189
2190     $c->log->debug(
2191         sprintf(
2192             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2193             $response->status                            || 'unknown',
2194             $response->headers->header('Content-Type')   || 'unknown',
2195             $response->headers->header('Content-Length') || 'unknown'
2196         )
2197     );
2198 }
2199
2200 =head2 $c->log_response_headers($headers);
2201
2202 Hook method which can be wrapped by plugins to log the responseheaders.
2203 No-op in the default implementation.
2204
2205 =cut
2206
2207 sub log_response_headers {}
2208
2209 =head2 $c->log_request_parameters( query => {}, body => {} )
2210
2211 Logs request parameters to debug logs
2212
2213 =cut
2214
2215 sub log_request_parameters {
2216     my $c          = shift;
2217     my %all_params = @_;
2218
2219     return unless $c->debug;
2220
2221     my $column_width = Catalyst::Utils::term_width() - 44;
2222     foreach my $type (qw(query body)) {
2223         my $params = $all_params{$type};
2224         next if ! keys %$params;
2225         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2226         for my $key ( sort keys %$params ) {
2227             my $param = $params->{$key};
2228             my $value = defined($param) ? $param : '';
2229             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2230         }
2231         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2232     }
2233 }
2234
2235 =head2 $c->log_request_uploads
2236
2237 Logs file uploads included in the request to the debug logs.
2238 The parameter name, filename, file type, and file size are all included in
2239 the debug logs.
2240
2241 =cut
2242
2243 sub log_request_uploads {
2244     my $c = shift;
2245     my $request = shift;
2246     return unless $c->debug;
2247     my $uploads = $request->uploads;
2248     if ( keys %$uploads ) {
2249         my $t = Text::SimpleTable->new(
2250             [ 12, 'Parameter' ],
2251             [ 26, 'Filename' ],
2252             [ 18, 'Type' ],
2253             [ 9,  'Size' ]
2254         );
2255         for my $key ( sort keys %$uploads ) {
2256             my $upload = $uploads->{$key};
2257             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2258                 $t->row( $key, $u->filename, $u->type, $u->size );
2259             }
2260         }
2261         $c->log->debug( "File Uploads are:\n" . $t->draw );
2262     }
2263 }
2264
2265 =head2 $c->log_request_headers($headers);
2266
2267 Hook method which can be wrapped by plugins to log the request headers.
2268 No-op in the default implementation.
2269
2270 =cut
2271
2272 sub log_request_headers {}
2273
2274 =head2 $c->log_headers($type => $headers)
2275
2276 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2277
2278 =cut
2279
2280 sub log_headers {
2281     my $c       = shift;
2282     my $type    = shift;
2283     my $headers = shift;    # an HTTP::Headers instance
2284
2285     return unless $c->debug;
2286
2287     my $column_width = Catalyst::Utils::term_width() - 28;
2288     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2289     $headers->scan(
2290         sub {
2291             my ( $name, $value ) = @_;
2292             $t->row( $name, $value );
2293         }
2294     );
2295     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2296 }
2297
2298
2299 =head2 $c->prepare_read
2300
2301 Prepares the input for reading.
2302
2303 =cut
2304
2305 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2306
2307 =head2 $c->prepare_request
2308
2309 Prepares the engine request.
2310
2311 =cut
2312
2313 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2314
2315 =head2 $c->prepare_uploads
2316
2317 Prepares uploads.
2318
2319 =cut
2320
2321 sub prepare_uploads {
2322     my $c = shift;
2323
2324     $c->engine->prepare_uploads( $c, @_ );
2325 }
2326
2327 =head2 $c->prepare_write
2328
2329 Prepares the output for writing.
2330
2331 =cut
2332
2333 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2334
2335 =head2 $c->request_class
2336
2337 Returns or sets the request class.
2338
2339 =head2 $c->response_class
2340
2341 Returns or sets the response class.
2342
2343 =head2 $c->read( [$maxlength] )
2344
2345 Reads a chunk of data from the request body. This method is designed to
2346 be used in a while loop, reading C<$maxlength> bytes on every call.
2347 C<$maxlength> defaults to the size of the request if not specified.
2348
2349 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2350 directly.
2351
2352 Warning: If you use read(), Catalyst will not process the body,
2353 so you will not be able to access POST parameters or file uploads via
2354 $c->request.  You must handle all body parsing yourself.
2355
2356 =cut
2357
2358 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2359
2360 =head2 $c->run
2361
2362 Starts the engine.
2363
2364 =cut
2365
2366 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2367
2368 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2369
2370 Sets an action in a given namespace.
2371
2372 =cut
2373
2374 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2375
2376 =head2 $c->setup_actions($component)
2377
2378 Sets up actions for a component.
2379
2380 =cut
2381
2382 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2383
2384 =head2 $c->setup_components
2385
2386 This method is called internally to set up the application's components.
2387
2388 It finds modules by calling the L<locate_components> method, expands them to
2389 package names with the L<expand_component_module> method, and then installs
2390 each component into the application.
2391
2392 The C<setup_components> config option is passed to both of the above methods.
2393
2394 Installation of each component is performed by the L<setup_component> method,
2395 below.
2396
2397 =cut
2398
2399 sub setup_components {
2400     my $class = shift;
2401
2402     my $config  = $class->config->{ setup_components };
2403
2404     my @comps = sort { length $a <=> length $b }
2405                 $class->locate_components($config);
2406     my %comps = map { $_ => 1 } @comps;
2407
2408     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2409     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2410         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2411     ) if $deprecatedcatalyst_component_names;
2412
2413     for my $component ( @comps ) {
2414
2415         # We pass ignore_loaded here so that overlay files for (e.g.)
2416         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2417         # we know M::P::O found a file on disk so this is safe
2418
2419         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2420     }
2421
2422     for my $component (@comps) {
2423         my $instance = $class->components->{ $component } = $class->setup_component($component);
2424         my @expanded_components = $instance->can('expand_modules')
2425             ? $instance->expand_modules( $component, $config )
2426             : $class->expand_component_module( $component, $config );
2427         for my $component (@expanded_components) {
2428             next if $comps{$component};
2429             $class->components->{ $component } = $class->setup_component($component);
2430         }
2431     }
2432 }
2433
2434 =head2 $c->locate_components( $setup_component_config )
2435
2436 This method is meant to provide a list of component modules that should be
2437 setup for the application.  By default, it will use L<Module::Pluggable>.
2438
2439 Specify a C<setup_components> config option to pass additional options directly
2440 to L<Module::Pluggable>. To add additional search paths, specify a key named
2441 C<search_extra> as an array reference. Items in the array beginning with C<::>
2442 will have the application class name prepended to them.
2443
2444 =cut
2445
2446 sub locate_components {
2447     my $class  = shift;
2448     my $config = shift;
2449
2450     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2451     my $extra   = delete $config->{ search_extra } || [];
2452
2453     push @paths, @$extra;
2454
2455     my $locator = Module::Pluggable::Object->new(
2456         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2457         %$config
2458     );
2459
2460     my @comps = $locator->plugins;
2461
2462     return @comps;
2463 }
2464
2465 =head2 $c->expand_component_module( $component, $setup_component_config )
2466
2467 Components found by C<locate_components> will be passed to this method, which
2468 is expected to return a list of component (package) names to be set up.
2469
2470 =cut
2471
2472 sub expand_component_module {
2473     my ($class, $module) = @_;
2474     return Devel::InnerPackage::list_packages( $module );
2475 }
2476
2477 =head2 $c->setup_component
2478
2479 =cut
2480
2481 sub setup_component {
2482     my( $class, $component ) = @_;
2483
2484     unless ( $component->can( 'COMPONENT' ) ) {
2485         return $component;
2486     }
2487
2488     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2489     my $config = $class->config->{ $suffix } || {};
2490     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2491     # methods also pass it. local to avoid pointlessly shitting in config
2492     # for the debug screen, as $component is already the key name.
2493     local $config->{catalyst_component_name} = $component;
2494
2495     my $instance = eval { $component->COMPONENT( $class, $config ); };
2496
2497     if ( my $error = $@ ) {
2498         chomp $error;
2499         Catalyst::Exception->throw(
2500             message => qq/Couldn't instantiate component "$component", "$error"/
2501         );
2502     }
2503
2504     unless (blessed $instance) {
2505         my $metaclass = Moose::Util::find_meta($component);
2506         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2507         my $component_method_from = $method_meta->associated_metaclass->name;
2508         my $value = defined($instance) ? $instance : 'undef';
2509         Catalyst::Exception->throw(
2510             message =>
2511             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2512         );
2513     }
2514     return $instance;
2515 }
2516
2517 =head2 $c->setup_dispatcher
2518
2519 Sets up dispatcher.
2520
2521 =cut
2522
2523 sub setup_dispatcher {
2524     my ( $class, $dispatcher ) = @_;
2525
2526     if ($dispatcher) {
2527         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2528     }
2529
2530     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2531         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2532     }
2533
2534     unless ($dispatcher) {
2535         $dispatcher = $class->dispatcher_class;
2536     }
2537
2538     Class::MOP::load_class($dispatcher);
2539
2540     # dispatcher instance
2541     $class->dispatcher( $dispatcher->new );
2542 }
2543
2544 =head2 $c->setup_engine
2545
2546 Sets up engine.
2547
2548 =cut
2549
2550 sub setup_engine {
2551     my ($class, $engine) = @_;
2552
2553     unless ($engine) {
2554         $engine = $class->engine_class;
2555     }
2556     else {
2557         $engine = String::RewritePrefix->rewrite( { '' => 'Catalyst::Engine::', '+' => '' }, $engine );
2558     }
2559
2560     $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP';
2561
2562     Class::MOP::load_class($engine);
2563
2564     # check for old engines that are no longer compatible
2565     my $old_engine;
2566     if ( $engine->isa('Catalyst::Engine::Apache')
2567         && !Catalyst::Engine::Apache->VERSION )
2568     {
2569         $old_engine = 1;
2570     }
2571
2572     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2573         && Catalyst::Engine::Server->VERSION le '0.02' )
2574     {
2575         $old_engine = 1;
2576     }
2577
2578     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2579         && $engine->VERSION eq '0.01' )
2580     {
2581         $old_engine = 1;
2582     }
2583
2584     elsif ($engine->isa('Catalyst::Engine::Zeus')
2585         && $engine->VERSION eq '0.01' )
2586     {
2587         $old_engine = 1;
2588     }
2589
2590     if ($old_engine) {
2591         Catalyst::Exception->throw( message =>
2592               qq/Engine "$engine" is not supported by this version of Catalyst/
2593         );
2594     }
2595
2596     if ($ENV{MOD_PERL}) {
2597         # FIXME - Immutable
2598         $class->meta->add_method(handler => sub {
2599             my $r = shift;
2600             my $app = $class->psgi_app;
2601             use Plack::Handler::Apache2;
2602             Plack::Handler::Apache2->call_app($r, $app);
2603         });
2604     }
2605
2606     $class->engine( $engine->new );
2607     $class->psgi_app( $class->engine->build_psgi_app($class) );
2608
2609 }
2610
2611 =head2 $c->setup_home
2612
2613 Sets up the home directory.
2614
2615 =cut
2616
2617 sub setup_home {
2618     my ( $class, $home ) = @_;
2619
2620     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2621         $home = $env;
2622     }
2623
2624     $home ||= Catalyst::Utils::home($class);
2625
2626     if ($home) {
2627         #I remember recently being scolded for assigning config values like this
2628         $class->config->{home} ||= $home;
2629         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2630     }
2631 }
2632
2633 =head2 $c->setup_log
2634
2635 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2636 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2637 log to.
2638
2639 This method also installs a C<debug> method that returns a true value into the
2640 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2641 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2642
2643 Note that if the log has already been setup, by either a previous call to
2644 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2645 that this method won't actually set up the log object.
2646
2647 =cut
2648
2649 sub setup_log {
2650     my ( $class, $levels ) = @_;
2651
2652     $levels ||= '';
2653     $levels =~ s/^\s+//;
2654     $levels =~ s/\s+$//;
2655     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2656
2657     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2658     if ( defined $env_debug ) {
2659         $levels{debug} = 1 if $env_debug; # Ugly!
2660         delete($levels{debug}) unless $env_debug;
2661     }
2662
2663     unless ( $class->log ) {
2664         $class->log( Catalyst::Log->new(keys %levels) );
2665     }
2666
2667     if ( $levels{debug} ) {
2668         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2669         $class->log->debug('Debug messages enabled');
2670     }
2671 }
2672
2673 =head2 $c->setup_plugins
2674
2675 Sets up plugins.
2676
2677 =cut
2678
2679 =head2 $c->setup_stats
2680
2681 Sets up timing statistics class.
2682
2683 =cut
2684
2685 sub setup_stats {
2686     my ( $class, $stats ) = @_;
2687
2688     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2689
2690     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2691     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2692         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2693         $class->log->debug('Statistics enabled');
2694     }
2695 }
2696
2697
2698 =head2 $c->registered_plugins
2699
2700 Returns a sorted list of the plugins which have either been stated in the
2701 import list or which have been added via C<< MyApp->plugin(@args); >>.
2702
2703 If passed a given plugin name, it will report a boolean value indicating
2704 whether or not that plugin is loaded.  A fully qualified name is required if
2705 the plugin name does not begin with C<Catalyst::Plugin::>.
2706
2707  if ($c->registered_plugins('Some::Plugin')) {
2708      ...
2709  }
2710
2711 =cut
2712
2713 {
2714
2715     sub registered_plugins {
2716         my $proto = shift;
2717         return sort keys %{ $proto->_plugins } unless @_;
2718         my $plugin = shift;
2719         return 1 if exists $proto->_plugins->{$plugin};
2720         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2721     }
2722
2723     sub _register_plugin {
2724         my ( $proto, $plugin, $instant ) = @_;
2725         my $class = ref $proto || $proto;
2726
2727         Class::MOP::load_class( $plugin );
2728         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is decated and will not work in 5.81" )
2729             if $plugin->isa( 'Catalyst::Component' );
2730         $proto->_plugins->{$plugin} = 1;
2731         unless ($instant) {
2732             my $meta = Class::MOP::get_metaclass_by_name($class);
2733             $meta->superclasses($plugin, $meta->superclasses);
2734         }
2735         return $class;
2736     }
2737
2738     sub setup_plugins {
2739         my ( $class, $plugins ) = @_;
2740
2741         $class->_plugins( {} ) unless $class->_plugins;
2742         $plugins = Data::OptList::mkopt($plugins || []);
2743
2744         my @plugins = map {
2745             [ Catalyst::Utils::resolve_namespace(
2746                   $class . '::Plugin',
2747                   'Catalyst::Plugin', $_->[0]
2748               ),
2749               $_->[1],
2750             ]
2751          } @{ $plugins };
2752
2753         for my $plugin ( reverse @plugins ) {
2754             Class::MOP::load_class($plugin->[0], $plugin->[1]);
2755             my $meta = find_meta($plugin->[0]);
2756             next if $meta && $meta->isa('Moose::Meta::Role');
2757
2758             $class->_register_plugin($plugin->[0]);
2759         }
2760
2761         my @roles =
2762             map  { $_->[0]->name, $_->[1] }
2763             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
2764             map  { [find_meta($_->[0]), $_->[1]] }
2765             @plugins;
2766
2767         Moose::Util::apply_all_roles(
2768             $class => @roles
2769         ) if @roles;
2770     }
2771 }
2772
2773 =head2 $c->stack
2774
2775 Returns an arrayref of the internal execution stack (actions that are
2776 currently executing).
2777
2778 =head2 $c->stats
2779
2780 Returns the current timing statistics object. By default Catalyst uses
2781 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
2782 L<< stats_class|/"$c->stats_class" >>.
2783
2784 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
2785 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
2786 profile explicitly, although MyApp.pm still won't profile nor output anything
2787 by itself.
2788
2789 =head2 $c->stats_class
2790
2791 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
2792
2793 =head2 $c->use_stats
2794
2795 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
2796
2797 Note that this is a static method, not an accessor and should be overridden
2798 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2799
2800 =cut
2801
2802 sub use_stats { 0 }
2803
2804
2805 =head2 $c->write( $data )
2806
2807 Writes $data to the output stream. When using this method directly, you
2808 will need to manually set the C<Content-Length> header to the length of
2809 your output data, if known.
2810
2811 =cut
2812
2813 sub write {
2814     my $c = shift;
2815
2816     # Finalize headers if someone manually writes output
2817     $c->finalize_headers;
2818
2819     return $c->engine->write( $c, @_ );
2820 }
2821
2822 =head2 version
2823
2824 Returns the Catalyst version number. Mostly useful for "powered by"
2825 messages in template systems.
2826
2827 =cut
2828
2829 sub version { return $Catalyst::VERSION }
2830
2831 =head1 CONFIGURATION
2832
2833 There are a number of 'base' config variables which can be set:
2834
2835 =over
2836
2837 =item *
2838
2839 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
2840
2841 =item *
2842
2843 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
2844
2845 =item *
2846
2847 C<disable_component_resolution_regex_fallback> - Turns
2848 off the deprecated component resolution functionality so
2849 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
2850 are called then regex search will not be attempted on string values and
2851 instead C<undef> will be returned.
2852
2853 =item *
2854
2855 C<home> - The application home directory. In an uninstalled application,
2856 this is the top level application directory. In an installed application,
2857 this will be the directory containing C<< MyApp.pm >>.
2858
2859 =item *
2860
2861 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
2862
2863 =item *
2864
2865 C<name> - The name of the application in debug messages and the debug and
2866 welcome screens
2867
2868 =item *
2869
2870 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
2871 until it is accessed. This allows you to (for example) check authentication (and reject
2872 the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
2873
2874 =item *
2875
2876 C<root> - The root directory for templates. Usually this is just a
2877 subdirectory of the home directory, but you can set it to change the
2878 templates to a different directory.
2879
2880 =item *
2881
2882 C<search_extra> - Array reference passed to Module::Pluggable to for additional
2883 namespaces from which components will be loaded (and constructed and stored in
2884 C<< $c->components >>).
2885
2886 =item *
2887
2888 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
2889 to be shown in hit debug tables in the test server.
2890
2891 =item *
2892
2893 C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
2894 variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
2895 for more information.
2896
2897 =item *
2898
2899 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
2900
2901 =back
2902
2903 =head1 INTERNAL ACTIONS
2904
2905 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2906 C<_ACTION>, and C<_END>. These are by default not shown in the private
2907 action table, but you can make them visible with a config parameter.
2908
2909     MyApp->config(show_internal_actions => 1);
2910
2911 =head1 ON-DEMAND PARSER
2912
2913 The request body is usually parsed at the beginning of a request,
2914 but if you want to handle input yourself, you can enable on-demand
2915 parsing with a config parameter.
2916
2917     MyApp->config(parse_on_demand => 1);
2918
2919 =head1 PROXY SUPPORT
2920
2921 Many production servers operate using the common double-server approach,
2922 with a lightweight frontend web server passing requests to a larger
2923 backend server. An application running on the backend server must deal
2924 with two problems: the remote user always appears to be C<127.0.0.1> and
2925 the server's hostname will appear to be C<localhost> regardless of the
2926 virtual host that the user connected through.
2927
2928 Catalyst will automatically detect this situation when you are running
2929 the frontend and backend servers on the same machine. The following
2930 changes are made to the request.
2931
2932     $c->req->address is set to the user's real IP address, as read from
2933     the HTTP X-Forwarded-For header.
2934
2935     The host value for $c->req->base and $c->req->uri is set to the real
2936     host, as read from the HTTP X-Forwarded-Host header.
2937
2938 Additionally, you may be running your backend application on an insecure
2939 connection (port 80) while your frontend proxy is running under SSL.  If there
2940 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
2941 tell Catalyst what port the frontend listens on.  This will allow all URIs to
2942 be created properly.
2943
2944 In the case of passing in:
2945
2946     X-Forwarded-Port: 443
2947
2948 All calls to C<uri_for> will result in an https link, as is expected.
2949
2950 Obviously, your web server must support these headers for this to work.
2951
2952 In a more complex server farm environment where you may have your
2953 frontend proxy server(s) on different machines, you will need to set a
2954 configuration option to tell Catalyst to read the proxied data from the
2955 headers.
2956
2957     MyApp->config(using_frontend_proxy => 1);
2958
2959 If you do not wish to use the proxy support at all, you may set:
2960
2961     MyApp->config(ignore_frontend_proxy => 1);
2962
2963 =head1 THREAD SAFETY
2964
2965 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2966 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2967 believe the Catalyst core to be thread-safe.
2968
2969 If you plan to operate in a threaded environment, remember that all other
2970 modules you are using must also be thread-safe. Some modules, most notably
2971 L<DBD::SQLite>, are not thread-safe.
2972
2973 =head1 SUPPORT
2974
2975 IRC:
2976
2977     Join #catalyst on irc.perl.org.
2978
2979 Mailing Lists:
2980
2981     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2982     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2983
2984 Web:
2985
2986     http://catalyst.perl.org
2987
2988 Wiki:
2989
2990     http://dev.catalyst.perl.org
2991
2992 =head1 SEE ALSO
2993
2994 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2995
2996 =head2 L<Catalyst::Manual> - The Catalyst Manual
2997
2998 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
2999
3000 =head2 L<Catalyst::Engine> - Core engine
3001
3002 =head2 L<Catalyst::Log> - Log class.
3003
3004 =head2 L<Catalyst::Request> - Request object
3005
3006 =head2 L<Catalyst::Response> - Response object
3007
3008 =head2 L<Catalyst::Test> - The test suite.
3009
3010 =head1 PROJECT FOUNDER
3011
3012 sri: Sebastian Riedel <sri@cpan.org>
3013
3014 =head1 CONTRIBUTORS
3015
3016 abw: Andy Wardley
3017
3018 acme: Leon Brocard <leon@astray.com>
3019
3020 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
3021
3022 Andrew Bramble
3023
3024 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
3025
3026 Andrew Ruthven
3027
3028 andyg: Andy Grundman <andy@hybridized.org>
3029
3030 audreyt: Audrey Tang
3031
3032 bricas: Brian Cassidy <bricas@cpan.org>
3033
3034 Caelum: Rafael Kitover <rkitover@io.com>
3035
3036 chansen: Christian Hansen
3037
3038 chicks: Christopher Hicks
3039
3040 Chisel Wright C<pause@herlpacker.co.uk>
3041
3042 Danijel Milicevic C<me@danijel.de>
3043
3044 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
3045
3046 David Naughton, C<naughton@umn.edu>
3047
3048 David E. Wheeler
3049
3050 dhoss: Devin Austin <dhoss@cpan.org>
3051
3052 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
3053
3054 Drew Taylor
3055
3056 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
3057
3058 esskar: Sascha Kiefer
3059
3060 fireartist: Carl Franks <cfranks@cpan.org>
3061
3062 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
3063
3064 gabb: Danijel Milicevic
3065
3066 Gary Ashton Jones
3067
3068 Gavin Henry C<ghenry@perl.me.uk>
3069
3070 Geoff Richards
3071
3072 groditi: Guillermo Roditi <groditi@gmail.com>
3073
3074 hobbs: Andrew Rodland <andrew@cleverdomain.org>
3075
3076 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
3077
3078 jcamacho: Juan Camacho
3079
3080 jester: Jesse Sheidlower C<jester@panix.com>
3081
3082 jhannah: Jay Hannah <jay@jays.net>
3083
3084 Jody Belka
3085
3086 Johan Lindstrom
3087
3088 jon: Jon Schutz <jjschutz@cpan.org>
3089
3090 Jonathan Rockway C<< <jrockway@cpan.org> >>
3091
3092 Kieren Diment C<kd@totaldatasolution.com>
3093
3094 konobi: Scott McWhirter <konobi@cpan.org>
3095
3096 marcus: Marcus Ramberg <mramberg@cpan.org>
3097
3098 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
3099
3100 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
3101
3102 mugwump: Sam Vilain
3103
3104 naughton: David Naughton
3105
3106 ningu: David Kamholz <dkamholz@cpan.org>
3107
3108 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
3109
3110 numa: Dan Sully <daniel@cpan.org>
3111
3112 obra: Jesse Vincent
3113
3114 Octavian Rasnita
3115
3116 omega: Andreas Marienborg
3117
3118 Oleg Kostyuk <cub.uanic@gmail.com>
3119
3120 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
3121
3122 rafl: Florian Ragwitz <rafl@debian.org>
3123
3124 random: Roland Lammel <lammel@cpan.org>
3125
3126 Robert Sedlacek C<< <rs@474.at> >>
3127
3128 SpiceMan: Marcel Montes
3129
3130 sky: Arthur Bergman
3131
3132 szbalint: Balint Szilakszi <szbalint@cpan.org>
3133
3134 t0m: Tomas Doran <bobtfish@bobtfish.net>
3135
3136 Ulf Edvinsson
3137
3138 Viljo Marrandi C<vilts@yahoo.com>
3139
3140 Will Hawes C<info@whawes.co.uk>
3141
3142 willert: Sebastian Willert <willert@cpan.org>
3143
3144 wreis: Wallace Reis <wallace@reis.org.br>
3145
3146 Yuval Kogman, C<nothingmuch@woobling.org>
3147
3148 =head1 LICENSE
3149
3150 This library is free software. You can redistribute it and/or modify it under
3151 the same terms as Perl itself.
3152
3153 =cut
3154
3155 no Moose;
3156
3157 __PACKAGE__->meta->make_immutable;
3158
3159 1;