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