lib/Catalyst.pm

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