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