lib/Catalyst.pm

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