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