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