lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 use Moose::Meta::Class ();
   5 extends 'Catalyst::Component';
   6 use Moose::Util qw/find_meta/;
   7 use B::Hooks::EndOfScope ();
   8 use Catalyst::Exception;
   9 use Catalyst::Exception::Detach;
  10 use Catalyst::Exception::Go;
  11 use Catalyst::Log;
  12 use Catalyst::Request;
  13 use Catalyst::Request::Upload;
  14 use Catalyst::Response;
  15 use Catalyst::Utils;
  16 use Catalyst::Controller;
  17 use Data::OptList;
  18 use Devel::InnerPackage ();
  19 use File::stat;
  20 use Module::Pluggable::Object ();
  21 use Text::SimpleTable ();
  22 use Path::Class::Dir ();
  23 use Path::Class::File ();
  24 use URI ();
  25 use URI::http;
  26 use URI::https;
  27 use Tree::Simple qw/use_weak_refs/;
  28 use Tree::Simple::Visitor::FindByUID;
  29 use Class::C3::Adopt::NEXT;
  30 use List::MoreUtils qw/uniq/;
  31 use attributes;
  32 use String::RewritePrefix;
  33 use utf8;
  34 use Carp qw/croak carp shortmess/;
  35 use Try::Tiny;
  36
  37 BEGIN { require 5.008004; }
  38
  39 has stack => (is => 'ro', default => sub { [] });
  40 has stash => (is => 'rw', default => sub { {} });
  41 has state => (is => 'rw', default => 0);
  42 has stats => (is => 'rw');
  43 has action => (is => 'rw');
  44 has counter => (is => 'rw', default => sub { {} });
  45 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
  46 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
  47 has namespace => (is => 'rw');
  48
  49 sub depth { scalar @{ shift->stack || [] }; }
  50 sub comp { shift->component(@_) }
  51
  52 sub req {
  53     my $self = shift; return $self->request(@_);
  54 }
  55 sub res {
  56     my $self = shift; return $self->response(@_);
  57 }
  58
  59 # For backwards compatibility
  60 sub finalize_output { shift->finalize_body(@_) };
  61
  62 # For statistics
  63 our $COUNT     = 1;
  64 our $START     = time;
  65 our $RECURSION = 1000;
  66 our $DETACH    = Catalyst::Exception::Detach->new;
  67 our $GO        = Catalyst::Exception::Go->new;
  68
  69 #I imagine that very few of these really need to be class variables. if any.
  70 #maybe we should just make them attributes with a default?
  71 __PACKAGE__->mk_classdata($_)
  72   for qw/components arguments dispatcher engine log dispatcher_class
  73   engine_class context_class request_class response_class stats_class
  74   setup_finished/;
  75
  76 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  77 __PACKAGE__->engine_class('Catalyst::Engine');
  78 __PACKAGE__->request_class('Catalyst::Request');
  79 __PACKAGE__->response_class('Catalyst::Response');
  80 __PACKAGE__->stats_class('Catalyst::Stats');
  81
  82 # Remember to update this in Catalyst::Runtime as well!
  83
  84 our $VERSION = '5.80029';
  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     $class->setup_engine( delete $flags->{engine} );
1120     $class->setup_stats( delete $flags->{stats} );
1121
1122     for my $flag ( sort keys %{$flags} ) {
1123
1124         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1125             &$code( $class, delete $flags->{$flag} );
1126         }
1127         else {
1128             $class->log->warn(qq/Unknown flag "$flag"/);
1129         }
1130     }
1131
1132     eval { require Catalyst::Devel; };
1133     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1134         $class->log->warn(<<"EOF");
1135 You are running an old script!
1136
1137   Please update by running (this will overwrite existing files):
1138     catalyst.pl -force -scripts $class
1139
1140   or (this will not overwrite existing files):
1141     catalyst.pl -scripts $class
1142
1143 EOF
1144     }
1145
1146     if ( $class->debug ) {
1147         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1148
1149         if (@plugins) {
1150             my $column_width = Catalyst::Utils::term_width() - 6;
1151             my $t = Text::SimpleTable->new($column_width);
1152             $t->row($_) for @plugins;
1153             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1154         }
1155
1156         my $dispatcher = $class->dispatcher;
1157         my $engine     = $class->engine;
1158         my $home       = $class->config->{home};
1159
1160         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1161         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1162
1163         $home
1164           ? ( -d $home )
1165           ? $class->log->debug(qq/Found home "$home"/)
1166           : $class->log->debug(qq/Home "$home" doesn't exist/)
1167           : $class->log->debug(q/Couldn't find home/);
1168     }
1169
1170     # Call plugins setup, this is stupid and evil.
1171     # Also screws C3 badly on 5.10, hack to avoid.
1172     {
1173         no warnings qw/redefine/;
1174         local *setup = sub { };
1175         $class->setup unless $Catalyst::__AM_RESTARTING;
1176     }
1177
1178     # Initialize our data structure
1179     $class->components( {} );
1180
1181     $class->setup_components;
1182
1183     if ( $class->debug ) {
1184         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1185         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1186         for my $comp ( sort keys %{ $class->components } ) {
1187             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1188             $t->row( $comp, $type );
1189         }
1190         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1191           if ( keys %{ $class->components } );
1192     }
1193
1194     # Add our self to components, since we are also a component
1195     if( $class->isa('Catalyst::Controller') ){
1196       $class->components->{$class} = $class;
1197     }
1198
1199     $class->setup_actions;
1200
1201     if ( $class->debug ) {
1202         my $name = $class->config->{name} || 'Application';
1203         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1204     }
1205
1206     # Make sure that the application class becomes immutable at this point,
1207     B::Hooks::EndOfScope::on_scope_end {
1208         return if $@;
1209         my $meta = Class::MOP::get_metaclass_by_name($class);
1210         if (
1211             $meta->is_immutable
1212             && ! { $meta->immutable_options }->{replace_constructor}
1213             && (
1214                    $class->isa('Class::Accessor::Fast')
1215                 || $class->isa('Class::Accessor')
1216             )
1217         ) {
1218             warn "You made your application class ($class) immutable, "
1219                 . "but did not inline the\nconstructor. "
1220                 . "This will break catalyst, as your app \@ISA "
1221                 . "Class::Accessor(::Fast)?\nPlease pass "
1222                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1223         }
1224         $meta->make_immutable(
1225             replace_constructor => 1,
1226         ) unless $meta->is_immutable;
1227     };
1228
1229     if ($class->config->{case_sensitive}) {
1230         $class->log->warn($class . "->config->{case_sensitive} is set.");
1231         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1232     }
1233
1234     $class->setup_finalize;
1235     # Should be the last thing we do so that user things hooking
1236     # setup_finalize can log..
1237     $class->log->_flush() if $class->log->can('_flush');
1238     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
1239 }
1240
1241 =head2 $app->setup_finalize
1242
1243 A hook to attach modifiers to. This method does not do anything except set the
1244 C<setup_finished> accessor.
1245
1246 Applying method modifiers to the C<setup> method doesn't work, because of quirky thingsdone for plugin setup.
1247
1248 Example:
1249
1250     after setup_finalize => sub {
1251         my $app = shift;
1252
1253         ## do stuff here..
1254     };
1255
1256 =cut
1257
1258 sub setup_finalize {
1259     my ($class) = @_;
1260     $class->setup_finished(1);
1261 }
1262
1263 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1264
1265 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1266
1267 Constructs an absolute L<URI> object based on the application root, the
1268 provided path, and the additional arguments and query parameters provided.
1269 When used as a string, provides a textual URI.  If you need more flexibility
1270 than this (i.e. the option to provide relative URIs etc.) see
1271 L<Catalyst::Plugin::SmartURI>.
1272
1273 If no arguments are provided, the URI for the current action is returned.
1274 To return the current action and also provide @args, use
1275 C<< $c->uri_for( $c->action, @args ) >>.
1276
1277 If the first argument is a string, it is taken as a public URI path relative
1278 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1279 relative to the application root (if it does). It is then merged with
1280 C<< $c->request->base >>; any C<@args> are appended as additional path
1281 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1282
1283 If the first argument is a L<Catalyst::Action> it represents an action which
1284 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1285 optional C<\@captures> argument (an arrayref) allows passing the captured
1286 variables that are needed to fill in the paths of Chained and Regex actions;
1287 once the path is resolved, C<uri_for> continues as though a path was
1288 provided, appending any arguments or parameters and creating an absolute
1289 URI.
1290
1291 The captures for the current request can be found in
1292 C<< $c->request->captures >>, and actions can be resolved using
1293 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1294 path, use C<< $c->uri_for_action >> instead.
1295
1296   # Equivalent to $c->req->uri
1297   $c->uri_for($c->action, $c->req->captures,
1298       @{ $c->req->args }, $c->req->params);
1299
1300   # For the Foo action in the Bar controller
1301   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1302
1303   # Path to a static resource
1304   $c->uri_for('/static/images/logo.png');
1305
1306 =cut
1307
1308 sub uri_for {
1309     my ( $c, $path, @args ) = @_;
1310
1311     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1312         $path = $path->path_prefix;
1313         $path =~ s{/+\z}{};
1314         $path .= '/';
1315     }
1316
1317     undef($path) if (defined $path && $path eq '');
1318
1319     my $params =
1320       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1321
1322     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1323     foreach my $arg (@args) {
1324         utf8::encode($arg) if utf8::is_utf8($arg);
1325         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1326     }
1327
1328     if ( blessed($path) ) { # action object
1329         s|/|%2F|g for @args;
1330         my $captures = [ map { s|/|%2F|g; $_; }
1331                         ( scalar @args && ref $args[0] eq 'ARRAY'
1332                          ? @{ shift(@args) }
1333                          : ()) ];
1334
1335         foreach my $capture (@$captures) {
1336             utf8::encode($capture) if utf8::is_utf8($capture);
1337             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1338         }
1339
1340         my $action = $path;
1341         $path = $c->dispatcher->uri_for_action($action, $captures);
1342         if (not defined $path) {
1343             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1344                 if $c->debug;
1345             return undef;
1346         }
1347         $path = '/' if $path eq '';
1348     }
1349
1350     unshift(@args, $path);
1351
1352     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1353         my $namespace = $c->namespace;
1354         if (defined $path) { # cheesy hack to handle path '../foo'
1355            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1356         }
1357         unshift(@args, $namespace || '');
1358     }
1359
1360     # join args with '/', or a blank string
1361     my $args = join('/', grep { defined($_) } @args);
1362     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1363     $args =~ s!^/+!!;
1364     my $base = $c->req->base;
1365     my $class = ref($base);
1366     $base =~ s{(?<!/)$}{/};
1367
1368     my $query = '';
1369
1370     if (my @keys = keys %$params) {
1371       # somewhat lifted from URI::_query's query_form
1372       $query = '?'.join('&', map {
1373           my $val = $params->{$_};
1374           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1375           s/ /+/g;
1376           my $key = $_;
1377           $val = '' unless defined $val;
1378           (map {
1379               my $param = "$_";
1380               utf8::encode( $param ) if utf8::is_utf8($param);
1381               # using the URI::Escape pattern here so utf8 chars survive
1382               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1383               $param =~ s/ /+/g;
1384               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1385       } @keys);
1386     }
1387
1388     my $res = bless(\"${base}${args}${query}", $class);
1389     $res;
1390 }
1391
1392 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1393
1394 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1395
1396 =over
1397
1398 =item $path
1399
1400 A private path to the Catalyst action you want to create a URI for.
1401
1402 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1403 >> and passing the resulting C<$action> and the remaining arguments to C<<
1404 $c->uri_for >>.
1405
1406 You can also pass in a Catalyst::Action object, in which case it is passed to
1407 C<< $c->uri_for >>.
1408
1409 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.
1410
1411 For example, if the action looks like:
1412
1413  package MyApp::Controller::Users;
1414
1415  sub lst : Path('the-list') {}
1416
1417 You can use:
1418
1419  $c->uri_for_action('/users/lst')
1420
1421 and it will create the URI /users/the-list.
1422
1423 =back
1424
1425 =cut
1426
1427 sub uri_for_action {
1428     my ( $c, $path, @args ) = @_;
1429     my $action = blessed($path)
1430       ? $path
1431       : $c->dispatcher->get_action_by_path($path);
1432     unless (defined $action) {
1433       croak "Can't find action for path '$path'";
1434     }
1435     return $c->uri_for( $action, @args );
1436 }
1437
1438 =head2 $c->welcome_message
1439
1440 Returns the Catalyst welcome HTML page.
1441
1442 =cut
1443
1444 sub welcome_message {
1445     my $c      = shift;
1446     my $name   = $c->config->{name};
1447     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1448     my $prefix = Catalyst::Utils::appprefix( ref $c );
1449     $c->response->content_type('text/html; charset=utf-8');
1450     return <<"EOF";
1451 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1452     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1453 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1454     <head>
1455     <meta http-equiv="Content-Language" content="en" />
1456     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1457         <title>$name on Catalyst $VERSION</title>
1458         <style type="text/css">
1459             body {
1460                 color: #000;
1461                 background-color: #eee;
1462             }
1463             div#content {
1464                 width: 640px;
1465                 margin-left: auto;
1466                 margin-right: auto;
1467                 margin-top: 10px;
1468                 margin-bottom: 10px;
1469                 text-align: left;
1470                 background-color: #ccc;
1471                 border: 1px solid #aaa;
1472             }
1473             p, h1, h2 {
1474                 margin-left: 20px;
1475                 margin-right: 20px;
1476                 font-family: verdana, tahoma, sans-serif;
1477             }
1478             a {
1479                 font-family: verdana, tahoma, sans-serif;
1480             }
1481             :link, :visited {
1482                     text-decoration: none;
1483                     color: #b00;
1484                     border-bottom: 1px dotted #bbb;
1485             }
1486             :link:hover, :visited:hover {
1487                     color: #555;
1488             }
1489             div#topbar {
1490                 margin: 0px;
1491             }
1492             pre {
1493                 margin: 10px;
1494                 padding: 8px;
1495             }
1496             div#answers {
1497                 padding: 8px;
1498                 margin: 10px;
1499                 background-color: #fff;
1500                 border: 1px solid #aaa;
1501             }
1502             h1 {
1503                 font-size: 0.9em;
1504                 font-weight: normal;
1505                 text-align: center;
1506             }
1507             h2 {
1508                 font-size: 1.0em;
1509             }
1510             p {
1511                 font-size: 0.9em;
1512             }
1513             p img {
1514                 float: right;
1515                 margin-left: 10px;
1516             }
1517             span#appname {
1518                 font-weight: bold;
1519                 font-size: 1.6em;
1520             }
1521         </style>
1522     </head>
1523     <body>
1524         <div id="content">
1525             <div id="topbar">
1526                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1527                     $VERSION</h1>
1528              </div>
1529              <div id="answers">
1530                  <p>
1531                  <img src="$logo" alt="Catalyst Logo" />
1532                  </p>
1533                  <p>Welcome to the  world of Catalyst.
1534                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1535                     framework will make web development something you had
1536                     never expected it to be: Fun, rewarding, and quick.</p>
1537                  <h2>What to do now?</h2>
1538                  <p>That really depends  on what <b>you</b> want to do.
1539                     We do, however, provide you with a few starting points.</p>
1540                  <p>If you want to jump right into web development with Catalyst
1541                     you might want to start with a tutorial.</p>
1542 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1543 </pre>
1544 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1545 <pre>
1546 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1547 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1548 </code></pre>
1549                  <h2>What to do next?</h2>
1550                  <p>Next it's time to write an actual application. Use the
1551                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1552                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1553                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1554                     they can save you a lot of work.</p>
1555                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1556                     <p>Also, be sure to check out the vast and growing
1557                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1558                     you are likely to find what you need there.
1559                     </p>
1560
1561                  <h2>Need help?</h2>
1562                  <p>Catalyst has a very active community. Here are the main places to
1563                     get in touch with us.</p>
1564                  <ul>
1565                      <li>
1566                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1567                      </li>
1568                      <li>
1569                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1570                      </li>
1571                      <li>
1572                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1573                      </li>
1574                  </ul>
1575                  <h2>In conclusion</h2>
1576                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1577                     as we enjoyed making it. Please contact us if you have ideas
1578                     for improvement or other feedback.</p>
1579              </div>
1580          </div>
1581     </body>
1582 </html>
1583 EOF
1584 }
1585
1586 =head1 INTERNAL METHODS
1587
1588 These methods are not meant to be used by end users.
1589
1590 =head2 $c->components
1591
1592 Returns a hash of components.
1593
1594 =head2 $c->context_class
1595
1596 Returns or sets the context class.
1597
1598 =head2 $c->counter
1599
1600 Returns a hashref containing coderefs and execution counts (needed for
1601 deep recursion detection).
1602
1603 =head2 $c->depth
1604
1605 Returns the number of actions on the current internal execution stack.
1606
1607 =head2 $c->dispatch
1608
1609 Dispatches a request to actions.
1610
1611 =cut
1612
1613 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1614
1615 =head2 $c->dispatcher_class
1616
1617 Returns or sets the dispatcher class.
1618
1619 =head2 $c->dump_these
1620
1621 Returns a list of 2-element array references (name, structure) pairs
1622 that will be dumped on the error page in debug mode.
1623
1624 =cut
1625
1626 sub dump_these {
1627     my $c = shift;
1628     [ Request => $c->req ],
1629     [ Response => $c->res ],
1630     [ Stash => $c->stash ],
1631     [ Config => $c->config ];
1632 }
1633
1634 =head2 $c->engine_class
1635
1636 Returns or sets the engine class.
1637
1638 =head2 $c->execute( $class, $coderef )
1639
1640 Execute a coderef in given class and catch exceptions. Errors are available
1641 via $c->error.
1642
1643 =cut
1644
1645 sub execute {
1646     my ( $c, $class, $code ) = @_;
1647     $class = $c->component($class) || $class;
1648     $c->state(0);
1649
1650     if ( $c->depth >= $RECURSION ) {
1651         my $action = $code->reverse();
1652         $action = "/$action" unless $action =~ /->/;
1653         my $error = qq/Deep recursion detected calling "${action}"/;
1654         $c->log->error($error);
1655         $c->error($error);
1656         $c->state(0);
1657         return $c->state;
1658     }
1659
1660     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1661
1662     push( @{ $c->stack }, $code );
1663
1664     no warnings 'recursion';
1665     eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1666
1667     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1668
1669     my $last = pop( @{ $c->stack } );
1670
1671     if ( my $error = $@ ) {
1672         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1673             $error->rethrow if $c->depth > 1;
1674         }
1675         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1676             $error->rethrow if $c->depth > 0;
1677         }
1678         else {
1679             unless ( ref $error ) {
1680                 no warnings 'uninitialized';
1681                 chomp $error;
1682                 my $class = $last->class;
1683                 my $name  = $last->name;
1684                 $error = qq/Caught exception in $class->$name "$error"/;
1685             }
1686             $c->error($error);
1687             $c->state(0);
1688         }
1689     }
1690     return $c->state;
1691 }
1692
1693 sub _stats_start_execute {
1694     my ( $c, $code ) = @_;
1695     my $appclass = ref($c) || $c;
1696     return if ( ( $code->name =~ /^_.*/ )
1697         && ( !$appclass->config->{show_internal_actions} ) );
1698
1699     my $action_name = $code->reverse();
1700     $c->counter->{$action_name}++;
1701
1702     my $action = $action_name;
1703     $action = "/$action" unless $action =~ /->/;
1704
1705     # determine if the call was the result of a forward
1706     # this is done by walking up the call stack and looking for a calling
1707     # sub of Catalyst::forward before the eval
1708     my $callsub = q{};
1709     for my $index ( 2 .. 11 ) {
1710         last
1711         if ( ( caller($index) )[0] eq 'Catalyst'
1712             && ( caller($index) )[3] eq '(eval)' );
1713
1714         if ( ( caller($index) )[3] =~ /forward$/ ) {
1715             $callsub = ( caller($index) )[3];
1716             $action  = "-> $action";
1717             last;
1718         }
1719     }
1720
1721     my $uid = $action_name . $c->counter->{$action_name};
1722
1723     # is this a root-level call or a forwarded call?
1724     if ( $callsub =~ /forward$/ ) {
1725         my $parent = $c->stack->[-1];
1726
1727         # forward, locate the caller
1728         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1729             $c->stats->profile(
1730                 begin  => $action,
1731                 parent => "$parent" . $c->counter->{"$parent"},
1732                 uid    => $uid,
1733             );
1734         }
1735         else {
1736
1737             # forward with no caller may come from a plugin
1738             $c->stats->profile(
1739                 begin => $action,
1740                 uid   => $uid,
1741             );
1742         }
1743     }
1744     else {
1745
1746         # root-level call
1747         $c->stats->profile(
1748             begin => $action,
1749             uid   => $uid,
1750         );
1751     }
1752     return $action;
1753
1754 }
1755
1756 sub _stats_finish_execute {
1757     my ( $c, $info ) = @_;
1758     $c->stats->profile( end => $info );
1759 }
1760
1761 =head2 $c->finalize
1762
1763 Finalizes the request.
1764
1765 =cut
1766
1767 sub finalize {
1768     my $c = shift;
1769
1770     for my $error ( @{ $c->error } ) {
1771         $c->log->error($error);
1772     }
1773
1774     # Allow engine to handle finalize flow (for POE)
1775     my $engine = $c->engine;
1776     if ( my $code = $engine->can('finalize') ) {
1777         $engine->$code($c);
1778     }
1779     else {
1780
1781         $c->finalize_uploads;
1782
1783         # Error
1784         if ( $#{ $c->error } >= 0 ) {
1785             $c->finalize_error;
1786         }
1787
1788         $c->finalize_headers;
1789
1790         # HEAD request
1791         if ( $c->request->method eq 'HEAD' ) {
1792             $c->response->body('');
1793         }
1794
1795         $c->finalize_body;
1796     }
1797
1798     $c->log_response;
1799
1800     if ($c->use_stats) {
1801         my $elapsed = sprintf '%f', $c->stats->elapsed;
1802         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1803         $c->log->info(
1804             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1805     }
1806
1807     return $c->response->status;
1808 }
1809
1810 =head2 $c->finalize_body
1811
1812 Finalizes body.
1813
1814 =cut
1815
1816 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1817
1818 =head2 $c->finalize_cookies
1819
1820 Finalizes cookies.
1821
1822 =cut
1823
1824 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1825
1826 =head2 $c->finalize_error
1827
1828 Finalizes error.
1829
1830 =cut
1831
1832 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1833
1834 =head2 $c->finalize_headers
1835
1836 Finalizes headers.
1837
1838 =cut
1839
1840 sub finalize_headers {
1841     my $c = shift;
1842
1843     my $response = $c->response; #accessor calls can add up?
1844
1845     # Check if we already finalized headers
1846     return if $response->finalized_headers;
1847
1848     # Handle redirects
1849     if ( my $location = $response->redirect ) {
1850         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1851         $response->header( Location => $location );
1852
1853         if ( !$response->has_body ) {
1854             # Add a default body if none is already present
1855             $response->body(
1856                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1857             );
1858         }
1859     }
1860
1861     # Content-Length
1862     if ( $response->body && !$response->content_length ) {
1863
1864         # get the length from a filehandle
1865         if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
1866         {
1867             my $stat = stat $response->body;
1868             if ( $stat && $stat->size > 0 ) {
1869                 $response->content_length( $stat->size );
1870             }
1871             else {
1872                 $c->log->warn('Serving filehandle without a content-length');
1873             }
1874         }
1875         else {
1876             # everything should be bytes at this point, but just in case
1877             $response->content_length( length( $response->body ) );
1878         }
1879     }
1880
1881     # Errors
1882     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1883         $response->headers->remove_header("Content-Length");
1884         $response->body('');
1885     }
1886
1887     $c->finalize_cookies;
1888
1889     $c->engine->finalize_headers( $c, @_ );
1890
1891     # Done
1892     $response->finalized_headers(1);
1893 }
1894
1895 =head2 $c->finalize_output
1896
1897 An alias for finalize_body.
1898
1899 =head2 $c->finalize_read
1900
1901 Finalizes the input after reading is complete.
1902
1903 =cut
1904
1905 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1906
1907 =head2 $c->finalize_uploads
1908
1909 Finalizes uploads. Cleans up any temporary files.
1910
1911 =cut
1912
1913 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1914
1915 =head2 $c->get_action( $action, $namespace )
1916
1917 Gets an action in a given namespace.
1918
1919 =cut
1920
1921 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1922
1923 =head2 $c->get_actions( $action, $namespace )
1924
1925 Gets all actions of a given name in a namespace and all parent
1926 namespaces.
1927
1928 =cut
1929
1930 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1931
1932 =head2 $app->handle_request( @arguments )
1933
1934 Called to handle each HTTP request.
1935
1936 =cut
1937
1938 sub handle_request {
1939     my ( $class, @arguments ) = @_;
1940
1941     # Always expect worst case!
1942     my $status = -1;
1943     try {
1944         if ($class->debug) {
1945             my $secs = time - $START || 1;
1946             my $av = sprintf '%.3f', $COUNT / $secs;
1947             my $time = localtime time;
1948             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1949         }
1950
1951         my $c = $class->prepare(@arguments);
1952         $c->dispatch;
1953         $status = $c->finalize;
1954     }
1955     catch {
1956         chomp(my $error = $_);
1957         $class->log->error(qq/Caught exception in engine "$error"/);
1958     };
1959
1960     $COUNT++;
1961
1962     if(my $coderef = $class->log->can('_flush')){
1963         $class->log->$coderef();
1964     }
1965     return $status;
1966 }
1967
1968 =head2 $c->prepare( @arguments )
1969
1970 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1971 etc.).
1972
1973 =cut
1974
1975 sub prepare {
1976     my ( $class, @arguments ) = @_;
1977
1978     # XXX
1979     # After the app/ctxt split, this should become an attribute based on something passed
1980     # into the application.
1981     $class->context_class( ref $class || $class ) unless $class->context_class;
1982
1983     my $c = $class->context_class->new({});
1984
1985     # For on-demand data
1986     $c->request->_context($c);
1987     $c->response->_context($c);
1988
1989     #surely this is not the most efficient way to do things...
1990     $c->stats($class->stats_class->new)->enable($c->use_stats);
1991     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
1992         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1993     }
1994
1995     try {
1996         # Allow engine to direct the prepare flow (for POE)
1997         if ( my $prepare = $c->engine->can('prepare') ) {
1998             $c->engine->$prepare( $c, @arguments );
1999         }
2000         else {
2001             $c->prepare_request(@arguments);
2002             $c->prepare_connection;
2003             $c->prepare_query_parameters;
2004             $c->prepare_headers;
2005             $c->prepare_cookies;
2006             $c->prepare_path;
2007
2008             # Prepare the body for reading, either by prepare_body
2009             # or the user, if they are using $c->read
2010             $c->prepare_read;
2011
2012             # Parse the body unless the user wants it on-demand
2013             unless ( ref($c)->config->{parse_on_demand} ) {
2014                 $c->prepare_body;
2015             }
2016         }
2017     }
2018     # VERY ugly and probably shouldn't rely on ->finalize actually working
2019     catch {
2020         # failed prepare is always due to an invalid request, right?
2021         $c->response->status(400);
2022         $c->response->content_type('text/plain');
2023         $c->response->body('Bad Request');
2024         $c->finalize;
2025         die $_;
2026     };
2027
2028     my $method  = $c->req->method  || '';
2029     my $path    = $c->req->path;
2030     $path       = '/' unless length $path;
2031     my $address = $c->req->address || '';
2032
2033     $c->log_request;
2034
2035     $c->prepare_action;
2036
2037     return $c;
2038 }
2039
2040 =head2 $c->prepare_action
2041
2042 Prepares action. See L<Catalyst::Dispatcher>.
2043
2044 =cut
2045
2046 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
2047
2048 =head2 $c->prepare_body
2049
2050 Prepares message body.
2051
2052 =cut
2053
2054 sub prepare_body {
2055     my $c = shift;
2056
2057     return if $c->request->_has_body;
2058
2059     # Initialize on-demand data
2060     $c->engine->prepare_body( $c, @_ );
2061     $c->prepare_parameters;
2062     $c->prepare_uploads;
2063 }
2064
2065 =head2 $c->prepare_body_chunk( $chunk )
2066
2067 Prepares a chunk of data before sending it to L<HTTP::Body>.
2068
2069 See L<Catalyst::Engine>.
2070
2071 =cut
2072
2073 sub prepare_body_chunk {
2074     my $c = shift;
2075     $c->engine->prepare_body_chunk( $c, @_ );
2076 }
2077
2078 =head2 $c->prepare_body_parameters
2079
2080 Prepares body parameters.
2081
2082 =cut
2083
2084 sub prepare_body_parameters {
2085     my $c = shift;
2086     $c->engine->prepare_body_parameters( $c, @_ );
2087 }
2088
2089 =head2 $c->prepare_connection
2090
2091 Prepares connection.
2092
2093 =cut
2094
2095 sub prepare_connection {
2096     my $c = shift;
2097     $c->engine->prepare_connection( $c, @_ );
2098 }
2099
2100 =head2 $c->prepare_cookies
2101
2102 Prepares cookies.
2103
2104 =cut
2105
2106 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
2107
2108 =head2 $c->prepare_headers
2109
2110 Prepares headers.
2111
2112 =cut
2113
2114 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
2115
2116 =head2 $c->prepare_parameters
2117
2118 Prepares parameters.
2119
2120 =cut
2121
2122 sub prepare_parameters {
2123     my $c = shift;
2124     $c->prepare_body_parameters;
2125     $c->engine->prepare_parameters( $c, @_ );
2126 }
2127
2128 =head2 $c->prepare_path
2129
2130 Prepares path and base.
2131
2132 =cut
2133
2134 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2135
2136 =head2 $c->prepare_query_parameters
2137
2138 Prepares query parameters.
2139
2140 =cut
2141
2142 sub prepare_query_parameters {
2143     my $c = shift;
2144
2145     $c->engine->prepare_query_parameters( $c, @_ );
2146 }
2147
2148 =head2 $c->log_request
2149
2150 Writes information about the request to the debug logs.  This includes:
2151
2152 =over 4
2153
2154 =item * Request method, path, and remote IP address
2155
2156 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2157
2158 =item * Request parameters
2159
2160 =item * File uploads
2161
2162 =back
2163
2164 =cut
2165
2166 sub log_request {
2167     my $c = shift;
2168
2169     return unless $c->debug;
2170
2171     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2172     my $request = $dump->[1];
2173
2174     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2175     $method ||= '';
2176     $path = '/' unless length $path;
2177     $address ||= '';
2178     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2179
2180     $c->log_request_headers($request->headers);
2181
2182     if ( my $keywords = $request->query_keywords ) {
2183         $c->log->debug("Query keywords are: $keywords");
2184     }
2185
2186     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2187
2188     $c->log_request_uploads($request);
2189 }
2190
2191 =head2 $c->log_response
2192
2193 Writes information about the response to the debug logs by calling
2194 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2195
2196 =cut
2197
2198 sub log_response {
2199     my $c = shift;
2200
2201     return unless $c->debug;
2202
2203     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2204     my $response = $dump->[1];
2205
2206     $c->log_response_status_line($response);
2207     $c->log_response_headers($response->headers);
2208 }
2209
2210 =head2 $c->log_response_status_line($response)
2211
2212 Writes one line of information about the response to the debug logs.  This includes:
2213
2214 =over 4
2215
2216 =item * Response status code
2217
2218 =item * Content-Type header (if present)
2219
2220 =item * Content-Length header (if present)
2221
2222 =back
2223
2224 =cut
2225
2226 sub log_response_status_line {
2227     my ($c, $response) = @_;
2228
2229     $c->log->debug(
2230         sprintf(
2231             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2232             $response->status                            || 'unknown',
2233             $response->headers->header('Content-Type')   || 'unknown',
2234             $response->headers->header('Content-Length') || 'unknown'
2235         )
2236     );
2237 }
2238
2239 =head2 $c->log_response_headers($headers);
2240
2241 Hook method which can be wrapped by plugins to log the responseheaders.
2242 No-op in the default implementation.
2243
2244 =cut
2245
2246 sub log_response_headers {}
2247
2248 =head2 $c->log_request_parameters( query => {}, body => {} )
2249
2250 Logs request parameters to debug logs
2251
2252 =cut
2253
2254 sub log_request_parameters {
2255     my $c          = shift;
2256     my %all_params = @_;
2257
2258     return unless $c->debug;
2259
2260     my $column_width = Catalyst::Utils::term_width() - 44;
2261     foreach my $type (qw(query body)) {
2262         my $params = $all_params{$type};
2263         next if ! keys %$params;
2264         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2265         for my $key ( sort keys %$params ) {
2266             my $param = $params->{$key};
2267             my $value = defined($param) ? $param : '';
2268             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2269         }
2270         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2271     }
2272 }
2273
2274 =head2 $c->log_request_uploads
2275
2276 Logs file uploads included in the request to the debug logs.
2277 The parameter name, filename, file type, and file size are all included in
2278 the debug logs.
2279
2280 =cut
2281
2282 sub log_request_uploads {
2283     my $c = shift;
2284     my $request = shift;
2285     return unless $c->debug;
2286     my $uploads = $request->uploads;
2287     if ( keys %$uploads ) {
2288         my $t = Text::SimpleTable->new(
2289             [ 12, 'Parameter' ],
2290             [ 26, 'Filename' ],
2291             [ 18, 'Type' ],
2292             [ 9,  'Size' ]
2293         );
2294         for my $key ( sort keys %$uploads ) {
2295             my $upload = $uploads->{$key};
2296             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2297                 $t->row( $key, $u->filename, $u->type, $u->size );
2298             }
2299         }
2300         $c->log->debug( "File Uploads are:\n" . $t->draw );
2301     }
2302 }
2303
2304 =head2 $c->log_request_headers($headers);
2305
2306 Hook method which can be wrapped by plugins to log the request headers.
2307 No-op in the default implementation.
2308
2309 =cut
2310
2311 sub log_request_headers {}
2312
2313 =head2 $c->log_headers($type => $headers)
2314
2315 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2316
2317 =cut
2318
2319 sub log_headers {
2320     my $c       = shift;
2321     my $type    = shift;
2322     my $headers = shift;    # an HTTP::Headers instance
2323
2324     return unless $c->debug;
2325
2326     my $column_width = Catalyst::Utils::term_width() - 28;
2327     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2328     $headers->scan(
2329         sub {
2330             my ( $name, $value ) = @_;
2331             $t->row( $name, $value );
2332         }
2333     );
2334     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2335 }
2336
2337
2338 =head2 $c->prepare_read
2339
2340 Prepares the input for reading.
2341
2342 =cut
2343
2344 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2345
2346 =head2 $c->prepare_request
2347
2348 Prepares the engine request.
2349
2350 =cut
2351
2352 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2353
2354 =head2 $c->prepare_uploads
2355
2356 Prepares uploads.
2357
2358 =cut
2359
2360 sub prepare_uploads {
2361     my $c = shift;
2362
2363     $c->engine->prepare_uploads( $c, @_ );
2364 }
2365
2366 =head2 $c->prepare_write
2367
2368 Prepares the output for writing.
2369
2370 =cut
2371
2372 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2373
2374 =head2 $c->request_class
2375
2376 Returns or sets the request class.
2377
2378 =head2 $c->response_class
2379
2380 Returns or sets the response class.
2381
2382 =head2 $c->read( [$maxlength] )
2383
2384 Reads a chunk of data from the request body. This method is designed to
2385 be used in a while loop, reading C<$maxlength> bytes on every call.
2386 C<$maxlength> defaults to the size of the request if not specified.
2387
2388 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2389 directly.
2390
2391 Warning: If you use read(), Catalyst will not process the body,
2392 so you will not be able to access POST parameters or file uploads via
2393 $c->request.  You must handle all body parsing yourself.
2394
2395 =cut
2396
2397 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2398
2399 =head2 $c->run
2400
2401 Starts the engine.
2402
2403 =cut
2404
2405 sub run { my $c = shift; return $c->engine->run( $c, $c->psgi_app, @_ ) }
2406
2407 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2408
2409 Sets an action in a given namespace.
2410
2411 =cut
2412
2413 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2414
2415 =head2 $c->setup_actions($component)
2416
2417 Sets up actions for a component.
2418
2419 =cut
2420
2421 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2422
2423 =head2 $c->setup_components
2424
2425 This method is called internally to set up the application's components.
2426
2427 It finds modules by calling the L<locate_components> method, expands them to
2428 package names with the L<expand_component_module> method, and then installs
2429 each component into the application.
2430
2431 The C<setup_components> config option is passed to both of the above methods.
2432
2433 Installation of each component is performed by the L<setup_component> method,
2434 below.
2435
2436 =cut
2437
2438 sub setup_components {
2439     my $class = shift;
2440
2441     my $config  = $class->config->{ setup_components };
2442
2443     my @comps = $class->locate_components($config);
2444     my %comps = map { $_ => 1 } @comps;
2445
2446     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2447     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2448         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2449     ) if $deprecatedcatalyst_component_names;
2450
2451     for my $component ( @comps ) {
2452
2453         # We pass ignore_loaded here so that overlay files for (e.g.)
2454         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2455         # we know M::P::O found a file on disk so this is safe
2456
2457         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2458     }
2459
2460     for my $component (@comps) {
2461         my $instance = $class->components->{ $component } = $class->setup_component($component);
2462         my @expanded_components = $instance->can('expand_modules')
2463             ? $instance->expand_modules( $component, $config )
2464             : $class->expand_component_module( $component, $config );
2465         for my $component (@expanded_components) {
2466             next if $comps{$component};
2467             $class->components->{ $component } = $class->setup_component($component);
2468         }
2469     }
2470 }
2471
2472 =head2 $c->locate_components( $setup_component_config )
2473
2474 This method is meant to provide a list of component modules that should be
2475 setup for the application.  By default, it will use L<Module::Pluggable>.
2476
2477 Specify a C<setup_components> config option to pass additional options directly
2478 to L<Module::Pluggable>. To add additional search paths, specify a key named
2479 C<search_extra> as an array reference. Items in the array beginning with C<::>
2480 will have the application class name prepended to them.
2481
2482 =cut
2483
2484 sub locate_components {
2485     my $class  = shift;
2486     my $config = shift;
2487
2488     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2489     my $extra   = delete $config->{ search_extra } || [];
2490
2491     push @paths, @$extra;
2492
2493     my $locator = Module::Pluggable::Object->new(
2494         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2495         %$config
2496     );
2497
2498     # XXX think about ditching this sort entirely
2499     my @comps = sort { length $a <=> length $b } $locator->plugins;
2500
2501     return @comps;
2502 }
2503
2504 =head2 $c->expand_component_module( $component, $setup_component_config )
2505
2506 Components found by C<locate_components> will be passed to this method, which
2507 is expected to return a list of component (package) names to be set up.
2508
2509 =cut
2510
2511 sub expand_component_module {
2512     my ($class, $module) = @_;
2513     return Devel::InnerPackage::list_packages( $module );
2514 }
2515
2516 =head2 $c->setup_component
2517
2518 =cut
2519
2520 sub setup_component {
2521     my( $class, $component ) = @_;
2522
2523     unless ( $component->can( 'COMPONENT' ) ) {
2524         return $component;
2525     }
2526
2527     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2528     my $config = $class->config->{ $suffix } || {};
2529     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2530     # methods also pass it. local to avoid pointlessly shitting in config
2531     # for the debug screen, as $component is already the key name.
2532     local $config->{catalyst_component_name} = $component;
2533
2534     my $instance = eval { $component->COMPONENT( $class, $config ); };
2535
2536     if ( my $error = $@ ) {
2537         chomp $error;
2538         Catalyst::Exception->throw(
2539             message => qq/Couldn't instantiate component "$component", "$error"/
2540         );
2541     }
2542
2543     unless (blessed $instance) {
2544         my $metaclass = Moose::Util::find_meta($component);
2545         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2546         my $component_method_from = $method_meta->associated_metaclass->name;
2547         my $value = defined($instance) ? $instance : 'undef';
2548         Catalyst::Exception->throw(
2549             message =>
2550             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2551         );
2552     }
2553     return $instance;
2554 }
2555
2556 =head2 $c->setup_dispatcher
2557
2558 Sets up dispatcher.
2559
2560 =cut
2561
2562 sub setup_dispatcher {
2563     my ( $class, $dispatcher ) = @_;
2564
2565     if ($dispatcher) {
2566         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2567     }
2568
2569     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2570         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2571     }
2572
2573     unless ($dispatcher) {
2574         $dispatcher = $class->dispatcher_class;
2575     }
2576
2577     Class::MOP::load_class($dispatcher);
2578
2579     # dispatcher instance
2580     $class->dispatcher( $dispatcher->new );
2581 }
2582
2583 =head2 $c->setup_engine
2584
2585 Sets up engine.
2586
2587 =cut
2588
2589 sub setup_engine {
2590     my ($class, $engine) = @_;
2591
2592     unless ($engine) {
2593         $engine = $class->engine_class;
2594     }
2595     else {
2596         $engine = String::RewritePrefix->rewrite( { '' => 'Catalyst::Engine::', '+' => '' }, $engine );
2597     }
2598
2599     $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP';
2600
2601     Class::MOP::load_class($engine);
2602
2603     # check for old engines that are no longer compatible
2604     my $old_engine;
2605     if ( $engine->isa('Catalyst::Engine::Apache')
2606         && !Catalyst::Engine::Apache->VERSION )
2607     {
2608         $old_engine = 1;
2609     }
2610
2611     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2612         && Catalyst::Engine::Server->VERSION le '0.02' )
2613     {
2614         $old_engine = 1;
2615     }
2616
2617     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2618         && $engine->VERSION eq '0.01' )
2619     {
2620         $old_engine = 1;
2621     }
2622
2623     elsif ($engine->isa('Catalyst::Engine::Zeus')
2624         && $engine->VERSION eq '0.01' )
2625     {
2626         $old_engine = 1;
2627     }
2628
2629     if ($old_engine) {
2630         Catalyst::Exception->throw( message =>
2631               qq/Engine "$engine" is not supported by this version of Catalyst/
2632         );
2633     }
2634
2635     if ($ENV{MOD_PERL}) {
2636         require 'Catalyst/Engine/Loader.pm';
2637         my $apache = Catalyst::Engine::Loader->auto;
2638         # FIXME - Immutable
2639         $class->meta->add_method(handler => sub {
2640             my $r = shift;
2641             my $app = $class->psgi_app;
2642             $apache->call_app($r, $app);
2643         });
2644     }
2645
2646     $class->engine( $engine->new );
2647
2648     return;
2649 }
2650
2651 sub psgi_app {
2652     my ($app) = @_;
2653     $app->setup_psgi_app;
2654 }
2655
2656 =head2 $c->setup_psgi_app
2657
2658 Builds a PSGI application coderef for the catalyst application C<$c>.
2659
2660 If we're able to locate a C<${myapp}.psgi> file in the applications home
2661 directory, we'll use that to obtain our code reference.
2662
2663 Otherwise the raw psgi app, without any middlewares is created using
2664 C<raw_psgi_app> and wrapped into L<Plack::Middleware::ReverseProxy>
2665 conditionally. See L</"PROXY SUPPORT">.
2666
2667 =cut
2668
2669 sub setup_psgi_app {
2670     my ($app) = @_;
2671
2672     if (my $home = Path::Class::Dir->new($app->config->{home})) {
2673         my $psgi_file = $home->file(
2674             Catalyst::Utils::appprefix($app) . '.psgi',
2675         );
2676
2677         return Plack::Util::load_psgi($psgi_file)
2678             if -e $psgi_file;
2679     }
2680
2681     return Plack::Middleware::Conditional->wrap(
2682         $app->raw_psgi_app,
2683         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2684         condition => sub {
2685             my ($env) = @_;
2686             return if $app->config->{ignore_frontend_proxy};
2687             return $env->{REMOTE_ADDR} eq '127.0.0.1'
2688                 || $app->config->{using_frontend_proxy};
2689         },
2690     );
2691 }
2692
2693 =head2 $c->raw_psgi_app
2694
2695 Returns a PSGI application code reference for the catalyst application
2696 C<$c>. This is the bare application without any middlewares
2697 applied. C<${myapp}.psgi> is not taken into account. See
2698 L</"$c->setup_psgi_app">.
2699
2700 =cut
2701
2702 sub raw_psgi_app {
2703     my ($app) = @_;
2704     return $app->engine->build_psgi_app($app);
2705 }
2706
2707 =head2 $c->setup_home
2708
2709 Sets up the home directory.
2710
2711 =cut
2712
2713 sub setup_home {
2714     my ( $class, $home ) = @_;
2715
2716     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2717         $home = $env;
2718     }
2719
2720     $home ||= Catalyst::Utils::home($class);
2721
2722     if ($home) {
2723         #I remember recently being scolded for assigning config values like this
2724         $class->config->{home} ||= $home;
2725         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2726     }
2727 }
2728
2729 =head2 $c->setup_log
2730
2731 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2732 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2733 log to.
2734
2735 This method also installs a C<debug> method that returns a true value into the
2736 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2737 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2738
2739 Note that if the log has already been setup, by either a previous call to
2740 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2741 that this method won't actually set up the log object.
2742
2743 =cut
2744
2745 sub setup_log {
2746     my ( $class, $levels ) = @_;
2747
2748     $levels ||= '';
2749     $levels =~ s/^\s+//;
2750     $levels =~ s/\s+$//;
2751     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2752
2753     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2754     if ( defined $env_debug ) {
2755         $levels{debug} = 1 if $env_debug; # Ugly!
2756         delete($levels{debug}) unless $env_debug;
2757     }
2758
2759     unless ( $class->log ) {
2760         $class->log( Catalyst::Log->new(keys %levels) );
2761     }
2762
2763     if ( $levels{debug} ) {
2764         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2765         $class->log->debug('Debug messages enabled');
2766     }
2767 }
2768
2769 =head2 $c->setup_plugins
2770
2771 Sets up plugins.
2772
2773 =cut
2774
2775 =head2 $c->setup_stats
2776
2777 Sets up timing statistics class.
2778
2779 =cut
2780
2781 sub setup_stats {
2782     my ( $class, $stats ) = @_;
2783
2784     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2785
2786     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2787     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2788         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2789         $class->log->debug('Statistics enabled');
2790     }
2791 }
2792
2793
2794 =head2 $c->registered_plugins
2795
2796 Returns a sorted list of the plugins which have either been stated in the
2797 import list or which have been added via C<< MyApp->plugin(@args); >>.
2798
2799 If passed a given plugin name, it will report a boolean value indicating
2800 whether or not that plugin is loaded.  A fully qualified name is required if
2801 the plugin name does not begin with C<Catalyst::Plugin::>.
2802
2803  if ($c->registered_plugins('Some::Plugin')) {
2804      ...
2805  }
2806
2807 =cut
2808
2809 {
2810
2811     sub registered_plugins {
2812         my $proto = shift;
2813         return sort keys %{ $proto->_plugins } unless @_;
2814         my $plugin = shift;
2815         return 1 if exists $proto->_plugins->{$plugin};
2816         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2817     }
2818
2819     sub _register_plugin {
2820         my ( $proto, $plugin, $instant ) = @_;
2821         my $class = ref $proto || $proto;
2822
2823         Class::MOP::load_class( $plugin );
2824         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is decated and will not work in 5.81" )
2825             if $plugin->isa( 'Catalyst::Component' );
2826         $proto->_plugins->{$plugin} = 1;
2827         unless ($instant) {
2828             my $meta = Class::MOP::get_metaclass_by_name($class);
2829             $meta->superclasses($plugin, $meta->superclasses);
2830         }
2831         return $class;
2832     }
2833
2834     sub setup_plugins {
2835         my ( $class, $plugins ) = @_;
2836
2837         $class->_plugins( {} ) unless $class->_plugins;
2838         $plugins = Data::OptList::mkopt($plugins || []);
2839
2840         my @plugins = map {
2841             [ Catalyst::Utils::resolve_namespace(
2842                   $class . '::Plugin',
2843                   'Catalyst::Plugin', $_->[0]
2844               ),
2845               $_->[1],
2846             ]
2847          } @{ $plugins };
2848
2849         for my $plugin ( reverse @plugins ) {
2850             Class::MOP::load_class($plugin->[0], $plugin->[1]);
2851             my $meta = find_meta($plugin->[0]);
2852             next if $meta && $meta->isa('Moose::Meta::Role');
2853
2854             $class->_register_plugin($plugin->[0]);
2855         }
2856
2857         my @roles =
2858             map  { $_->[0]->name, $_->[1] }
2859             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
2860             map  { [find_meta($_->[0]), $_->[1]] }
2861             @plugins;
2862
2863         Moose::Util::apply_all_roles(
2864             $class => @roles
2865         ) if @roles;
2866     }
2867 }
2868
2869 =head2 $c->stack
2870
2871 Returns an arrayref of the internal execution stack (actions that are
2872 currently executing).
2873
2874 =head2 $c->stats
2875
2876 Returns the current timing statistics object. By default Catalyst uses
2877 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
2878 L<< stats_class|/"$c->stats_class" >>.
2879
2880 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
2881 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
2882 profile explicitly, although MyApp.pm still won't profile nor output anything
2883 by itself.
2884
2885 =head2 $c->stats_class
2886
2887 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
2888
2889 =head2 $c->use_stats
2890
2891 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
2892
2893 Note that this is a static method, not an accessor and should be overridden
2894 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2895
2896 =cut
2897
2898 sub use_stats { 0 }
2899
2900
2901 =head2 $c->write( $data )
2902
2903 Writes $data to the output stream. When using this method directly, you
2904 will need to manually set the C<Content-Length> header to the length of
2905 your output data, if known.
2906
2907 =cut
2908
2909 sub write {
2910     my $c = shift;
2911
2912     # Finalize headers if someone manually writes output
2913     $c->finalize_headers;
2914
2915     return $c->engine->write( $c, @_ );
2916 }
2917
2918 =head2 version
2919
2920 Returns the Catalyst version number. Mostly useful for "powered by"
2921 messages in template systems.
2922
2923 =cut
2924
2925 sub version { return $Catalyst::VERSION }
2926
2927 =head1 CONFIGURATION
2928
2929 There are a number of 'base' config variables which can be set:
2930
2931 =over
2932
2933 =item *
2934
2935 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
2936
2937 =item *
2938
2939 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
2940
2941 =item *
2942
2943 C<disable_component_resolution_regex_fallback> - Turns
2944 off the deprecated component resolution functionality so
2945 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
2946 are called then regex search will not be attempted on string values and
2947 instead C<undef> will be returned.
2948
2949 =item *
2950
2951 C<home> - The application home directory. In an uninstalled application,
2952 this is the top level application directory. In an installed application,
2953 this will be the directory containing C<< MyApp.pm >>.
2954
2955 =item *
2956
2957 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
2958
2959 =item *
2960
2961 C<name> - The name of the application in debug messages and the debug and
2962 welcome screens
2963
2964 =item *
2965
2966 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
2967 until it is accessed. This allows you to (for example) check authentication (and reject
2968 the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
2969
2970 =item *
2971
2972 C<root> - The root directory for templates. Usually this is just a
2973 subdirectory of the home directory, but you can set it to change the
2974 templates to a different directory.
2975
2976 =item *
2977
2978 C<search_extra> - Array reference passed to Module::Pluggable to for additional
2979 namespaces from which components will be loaded (and constructed and stored in
2980 C<< $c->components >>).
2981
2982 =item *
2983
2984 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
2985 to be shown in hit debug tables in the test server.
2986
2987 =item *
2988
2989 C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
2990 variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
2991 for more information.
2992
2993 =item *
2994
2995 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
2996
2997 =back
2998
2999 =head1 INTERNAL ACTIONS
3000
3001 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3002 C<_ACTION>, and C<_END>. These are by default not shown in the private
3003 action table, but you can make them visible with a config parameter.
3004
3005     MyApp->config(show_internal_actions => 1);
3006
3007 =head1 ON-DEMAND PARSER
3008
3009 The request body is usually parsed at the beginning of a request,
3010 but if you want to handle input yourself, you can enable on-demand
3011 parsing with a config parameter.
3012
3013     MyApp->config(parse_on_demand => 1);
3014
3015 =head1 PROXY SUPPORT
3016
3017 Many production servers operate using the common double-server approach,
3018 with a lightweight frontend web server passing requests to a larger
3019 backend server. An application running on the backend server must deal
3020 with two problems: the remote user always appears to be C<127.0.0.1> and
3021 the server's hostname will appear to be C<localhost> regardless of the
3022 virtual host that the user connected through.
3023
3024 Catalyst will automatically detect this situation when you are running
3025 the frontend and backend servers on the same machine. The following
3026 changes are made to the request.
3027
3028     $c->req->address is set to the user's real IP address, as read from
3029     the HTTP X-Forwarded-For header.
3030
3031     The host value for $c->req->base and $c->req->uri is set to the real
3032     host, as read from the HTTP X-Forwarded-Host header.
3033
3034 Additionally, you may be running your backend application on an insecure
3035 connection (port 80) while your frontend proxy is running under SSL.  If there
3036 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3037 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3038 be created properly.
3039
3040 In the case of passing in:
3041
3042     X-Forwarded-Port: 443
3043
3044 All calls to C<uri_for> will result in an https link, as is expected.
3045
3046 Obviously, your web server must support these headers for this to work.
3047
3048 In a more complex server farm environment where you may have your
3049 frontend proxy server(s) on different machines, you will need to set a
3050 configuration option to tell Catalyst to read the proxied data from the
3051 headers.
3052
3053     MyApp->config(using_frontend_proxy => 1);
3054
3055 If you do not wish to use the proxy support at all, you may set:
3056
3057     MyApp->config(ignore_frontend_proxy => 1);
3058
3059 =head1 THREAD SAFETY
3060
3061 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3062 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3063 believe the Catalyst core to be thread-safe.
3064
3065 If you plan to operate in a threaded environment, remember that all other
3066 modules you are using must also be thread-safe. Some modules, most notably
3067 L<DBD::SQLite>, are not thread-safe.
3068
3069 =head1 SUPPORT
3070
3071 IRC:
3072
3073     Join #catalyst on irc.perl.org.
3074
3075 Mailing Lists:
3076
3077     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
3078     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
3079
3080 Web:
3081
3082     http://catalyst.perl.org
3083
3084 Wiki:
3085
3086     http://dev.catalyst.perl.org
3087
3088 =head1 SEE ALSO
3089
3090 =head2 L<Task::Catalyst> - All you need to start with Catalyst
3091
3092 =head2 L<Catalyst::Manual> - The Catalyst Manual
3093
3094 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
3095
3096 =head2 L<Catalyst::Engine> - Core engine
3097
3098 =head2 L<Catalyst::Log> - Log class.
3099
3100 =head2 L<Catalyst::Request> - Request object
3101
3102 =head2 L<Catalyst::Response> - Response object
3103
3104 =head2 L<Catalyst::Test> - The test suite.
3105
3106 =head1 PROJECT FOUNDER
3107
3108 sri: Sebastian Riedel <sri@cpan.org>
3109
3110 =head1 CONTRIBUTORS
3111
3112 abw: Andy Wardley
3113
3114 acme: Leon Brocard <leon@astray.com>
3115
3116 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
3117
3118 Andrew Bramble
3119
3120 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
3121
3122 Andrew Ruthven
3123
3124 andyg: Andy Grundman <andy@hybridized.org>
3125
3126 audreyt: Audrey Tang
3127
3128 bricas: Brian Cassidy <bricas@cpan.org>
3129
3130 Caelum: Rafael Kitover <rkitover@io.com>
3131
3132 chansen: Christian Hansen
3133
3134 chicks: Christopher Hicks
3135
3136 Chisel Wright C<pause@herlpacker.co.uk>
3137
3138 Danijel Milicevic C<me@danijel.de>
3139
3140 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
3141
3142 David Naughton, C<naughton@umn.edu>
3143
3144 David E. Wheeler
3145
3146 dhoss: Devin Austin <dhoss@cpan.org>
3147
3148 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
3149
3150 Drew Taylor
3151
3152 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
3153
3154 esskar: Sascha Kiefer
3155
3156 fireartist: Carl Franks <cfranks@cpan.org>
3157
3158 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
3159
3160 gabb: Danijel Milicevic
3161
3162 Gary Ashton Jones
3163
3164 Gavin Henry C<ghenry@perl.me.uk>
3165
3166 Geoff Richards
3167
3168 groditi: Guillermo Roditi <groditi@gmail.com>
3169
3170 hobbs: Andrew Rodland <andrew@cleverdomain.org>
3171
3172 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
3173
3174 jcamacho: Juan Camacho
3175
3176 jester: Jesse Sheidlower C<jester@panix.com>
3177
3178 jhannah: Jay Hannah <jay@jays.net>
3179
3180 Jody Belka
3181
3182 Johan Lindstrom
3183
3184 jon: Jon Schutz <jjschutz@cpan.org>
3185
3186 Jonathan Rockway C<< <jrockway@cpan.org> >>
3187
3188 Kieren Diment C<kd@totaldatasolution.com>
3189
3190 konobi: Scott McWhirter <konobi@cpan.org>
3191
3192 marcus: Marcus Ramberg <mramberg@cpan.org>
3193
3194 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
3195
3196 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
3197
3198 mugwump: Sam Vilain
3199
3200 naughton: David Naughton
3201
3202 ningu: David Kamholz <dkamholz@cpan.org>
3203
3204 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
3205
3206 numa: Dan Sully <daniel@cpan.org>
3207
3208 obra: Jesse Vincent
3209
3210 Octavian Rasnita
3211
3212 omega: Andreas Marienborg
3213
3214 Oleg Kostyuk <cub.uanic@gmail.com>
3215
3216 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
3217
3218 rafl: Florian Ragwitz <rafl@debian.org>
3219
3220 random: Roland Lammel <lammel@cpan.org>
3221
3222 Robert Sedlacek C<< <rs@474.at> >>
3223
3224 SpiceMan: Marcel Montes
3225
3226 sky: Arthur Bergman
3227
3228 szbalint: Balint Szilakszi <szbalint@cpan.org>
3229
3230 t0m: Tomas Doran <bobtfish@bobtfish.net>
3231
3232 Ulf Edvinsson
3233
3234 Viljo Marrandi C<vilts@yahoo.com>
3235
3236 Will Hawes C<info@whawes.co.uk>
3237
3238 willert: Sebastian Willert <willert@cpan.org>
3239
3240 wreis: Wallace Reis <wallace@reis.org.br>
3241
3242 Yuval Kogman, C<nothingmuch@woobling.org>
3243
3244 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
3245
3246 =head1 LICENSE
3247
3248 This library is free software. You can redistribute it and/or modify it under
3249 the same terms as Perl itself.
3250
3251 =cut
3252
3253 no Moose;
3254
3255 __PACKAGE__->meta->make_immutable;
3256
3257 1;