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