lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 extends 'Catalyst::Component';
   5 use bytes;
   6 use Catalyst::Exception;
   7 use Catalyst::Log;
   8 use Catalyst::Request;
   9 use Catalyst::Request::Upload;
  10 use Catalyst::Response;
  11 use Catalyst::Utils;
  12 use Catalyst::Controller;
  13 use Devel::InnerPackage ();
  14 use File::stat;
  15 use Module::Pluggable::Object ();
  16 use NEXT;
  17 use Text::SimpleTable ();
  18 use Path::Class::Dir ();
  19 use Path::Class::File ();
  20 use Time::HiRes qw/gettimeofday tv_interval/;
  21 use URI ();
  22 use URI::http;
  23 use URI::https;
  24 use Scalar::Util qw/weaken blessed/;
  25 use Tree::Simple qw/use_weak_refs/;
  26 use Tree::Simple::Visitor::FindByUID;
  27 use attributes;
  28 use utf8;
  29 use Carp qw/croak carp/;
  30
  31 BEGIN { require 5.008001; }
  32
  33 __PACKAGE__->mk_accessors(
  34     qw/counter request response state action stack namespace stats stash/
  35 );
  36
  37 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
  38
  39 sub depth { scalar @{ shift->stack || [] }; }
  40
  41 # Laziness++
  42 *comp = \&component;
  43 *req  = \&request;
  44 *res  = \&response;
  45
  46 # For backwards compatibility
  47 *finalize_output = \&finalize_body;
  48
  49 # For statistics
  50 our $COUNT     = 1;
  51 our $START     = time;
  52 our $RECURSION = 1000;
  53 our $DETACH    = "catalyst_detach\n";
  54
  55 __PACKAGE__->mk_classdata($_)
  56   for qw/components arguments dispatcher engine log dispatcher_class
  57   engine_class context_class request_class response_class stats_class
  58   setup_finished/;
  59
  60 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  61 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  62 __PACKAGE__->request_class('Catalyst::Request');
  63 __PACKAGE__->response_class('Catalyst::Response');
  64 __PACKAGE__->stats_class('Catalyst::Stats');
  65
  66 # Remember to update this in Catalyst::Runtime as well!
  67
  68 our $VERSION = '5.7013';
  69
  70 sub import {
  71     my ( $class, @arguments ) = @_;
  72
  73     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  74     # callers @ISA.
  75     return unless $class eq 'Catalyst';
  76
  77     my $caller = caller(0);
  78
  79     unless ( $caller->isa('Catalyst') ) {
  80         no strict 'refs';
  81         if( $caller->can('meta') ){
  82           my @superclasses = ($caller->meta->superclasses, $class, 'Catalyst::Controller');
  83           $caller->meta->superclasses(@superclasses);
  84         } else {
  85           push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
  86         }
  87     }
  88
  89     $caller->arguments( [@arguments] );
  90     $caller->setup_home;
  91 }
  92
  93 =head1 NAME
  94
  95 Catalyst - The Elegant MVC Web Application Framework
  96
  97 =head1 SYNOPSIS
  98
  99 See the L<Catalyst::Manual> distribution for comprehensive
 100 documentation and tutorials.
 101
 102     # Install Catalyst::Devel for helpers and other development tools
 103     # use the helper to create a new application
 104     catalyst.pl MyApp
 105
 106     # add models, views, controllers
 107     script/myapp_create.pl model MyDatabase DBIC::Schema create=dynamic dbi:SQLite:/path/to/db
 108     script/myapp_create.pl view MyTemplate TT
 109     script/myapp_create.pl controller Search
 110
 111     # built in testserver -- use -r to restart automatically on changes
 112     # --help to see all available options
 113     script/myapp_server.pl
 114
 115     # command line testing interface
 116     script/myapp_test.pl /yada
 117
 118     ### in lib/MyApp.pm
 119     use Catalyst qw/-Debug/; # include plugins here as well
 120
 121     ### In lib/MyApp/Controller/Root.pm (autocreated)
 122     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 123         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 124         $c->stash->{template} = 'foo.tt'; # set the template
 125         # lookup something from db -- stash vars are passed to TT
 126         $c->stash->{data} =
 127           $c->model('Database::Foo')->search( { country => $args[0] } );
 128         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 129             $c->forward( 'bar' ); # process another action
 130             # do something else after forward returns
 131         }
 132     }
 133
 134     # The foo.tt TT template can use the stash data from the database
 135     [% WHILE (item = data.next) %]
 136         [% item.foo %]
 137     [% END %]
 138
 139     # called for /bar/of/soap, /bar/of/soap/10, etc.
 140     sub bar : Path('/bar/of/soap') { ... }
 141
 142     # called for all actions, from the top-most controller downwards
 143     sub auto : Private {
 144         my ( $self, $c ) = @_;
 145         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 146             $c->res->redirect( '/login' ); # require login
 147             return 0; # abort request and go immediately to end()
 148         }
 149         return 1; # success; carry on to next action
 150     }
 151
 152     # called after all actions are finished
 153     sub end : Private {
 154         my ( $self, $c ) = @_;
 155         if ( scalar @{ $c->error } ) { ... } # handle errors
 156         return if $c->res->body; # already have a response
 157         $c->forward( 'MyApp::View::TT' ); # render template
 158     }
 159
 160     ### in MyApp/Controller/Foo.pm
 161     # called for /foo/bar
 162     sub bar : Local { ... }
 163
 164     # called for /blargle
 165     sub blargle : Global { ... }
 166
 167     # an index action matches /foo, but not /foo/1, etc.
 168     sub index : Private { ... }
 169
 170     ### in MyApp/Controller/Foo/Bar.pm
 171     # called for /foo/bar/baz
 172     sub baz : Local { ... }
 173
 174     # first Root auto is called, then Foo auto, then this
 175     sub auto : Private { ... }
 176
 177     # powerful regular expression paths are also possible
 178     sub details : Regex('^product/(\w+)/details$') {
 179         my ( $self, $c ) = @_;
 180         # extract the (\w+) from the URI
 181         my $product = $c->req->captures->[0];
 182     }
 183
 184 See L<Catalyst::Manual::Intro> for additional information.
 185
 186 =head1 DESCRIPTION
 187
 188 Catalyst is a modern framework for making web applications without the
 189 pain usually associated with this process. This document is a reference
 190 to the main Catalyst application. If you are a new user, we suggest you
 191 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 192
 193 See L<Catalyst::Manual> for more documentation.
 194
 195 Catalyst plugins can be loaded by naming them as arguments to the "use
 196 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 197 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 198 C<My::Module>.
 199
 200     use Catalyst qw/My::Module/;
 201
 202 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 203 fully qualify the name by using a unary plus:
 204
 205     use Catalyst qw/
 206         My::Module
 207         +Fully::Qualified::Plugin::Name
 208     /;
 209
 210 Special flags like C<-Debug> and C<-Engine> can also be specified as
 211 arguments when Catalyst is loaded:
 212
 213     use Catalyst qw/-Debug My::Module/;
 214
 215 The position of plugins and flags in the chain is important, because
 216 they are loaded in the order in which they appear.
 217
 218 The following flags are supported:
 219
 220 =head2 -Debug
 221
 222 Enables debug output. You can also force this setting from the system
 223 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 224 settings override the application, with <MYAPP>_DEBUG having the highest
 225 priority.
 226
 227 =head2 -Engine
 228
 229 Forces Catalyst to use a specific engine. Omit the
 230 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 231
 232     use Catalyst qw/-Engine=CGI/;
 233
 234 =head2 -Home
 235
 236 Forces Catalyst to use a specific home directory, e.g.:
 237
 238     use Catalyst qw[-Home=/usr/mst];
 239
 240 This can also be done in the shell environment by setting either the
 241 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 242 is replaced with the uppercased name of your application, any "::" in
 243 the name will be replaced with underscores, e.g. MyApp::Web should use
 244 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 245
 246 =head2 -Log
 247
 248 Specifies log level.
 249
 250 =head2 -Stats
 251
 252 Enables statistics collection and reporting. You can also force this setting
 253 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
 254 environment settings override the application, with <MYAPP>_STATS having the
 255 highest priority.
 256
 257 e.g.
 258
 259    use Catalyst qw/-Stats=1/
 260
 261 =head1 METHODS
 262
 263 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 264
 265 =head2 $c->action
 266
 267 Returns a L<Catalyst::Action> object for the current action, which
 268 stringifies to the action name. See L<Catalyst::Action>.
 269
 270 =head2 $c->namespace
 271
 272 Returns the namespace of the current action, i.e., the URI prefix
 273 corresponding to the controller of the current action. For example:
 274
 275     # in Controller::Foo::Bar
 276     $c->namespace; # returns 'foo/bar';
 277
 278 =head2 $c->request
 279
 280 =head2 $c->req
 281
 282 Returns the current L<Catalyst::Request> object, giving access to
 283 information about the current client request (including parameters,
 284 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 285
 286 =head2 REQUEST FLOW HANDLING
 287
 288 =head2 $c->forward( $action [, \@arguments ] )
 289
 290 =head2 $c->forward( $class, $method, [, \@arguments ] )
 291
 292 Forwards processing to another action, by its private name. If you give a
 293 class name but no method, C<process()> is called. You may also optionally
 294 pass arguments in an arrayref. The action will receive the arguments in
 295 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 296 C<< $c->req->args >> will be restored to the previous values.
 297
 298 Any data C<return>ed from the action forwarded to, will be returned by the
 299 call to forward.
 300
 301     my $foodata = $c->forward('/foo');
 302     $c->forward('index');
 303     $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
 304     $c->forward('MyApp::View::TT');
 305
 306 Note that forward implies an C<<eval { }>> around the call (actually
 307 C<execute> does), thus de-fatalizing all 'dies' within the called
 308 action. If you want C<die> to propagate you need to do something like:
 309
 310     $c->forward('foo');
 311     die $c->error if $c->error;
 312
 313 Or make sure to always return true values from your actions and write
 314 your code like this:
 315
 316     $c->forward('foo') || return;
 317
 318 =cut
 319
 320 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 321
 322 =head2 $c->detach( $action [, \@arguments ] )
 323
 324 =head2 $c->detach( $class, $method, [, \@arguments ] )
 325
 326 =head2 $c->detach()
 327
 328 The same as C<forward>, but doesn't return to the previous action when
 329 processing is finished.
 330
 331 When called with no arguments it escapes the processing chain entirely.
 332
 333 =cut
 334
 335 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 336
 337 =head2 $c->response
 338
 339 =head2 $c->res
 340
 341 Returns the current L<Catalyst::Response> object, see there for details.
 342
 343 =head2 $c->stash
 344
 345 Returns a hashref to the stash, which may be used to store data and pass
 346 it between components during a request. You can also set hash keys by
 347 passing arguments. The stash is automatically sent to the view. The
 348 stash is cleared at the end of a request; it cannot be used for
 349 persistent storage (for this you must use a session; see
 350 L<Catalyst::Plugin::Session> for a complete system integrated with
 351 Catalyst).
 352
 353     $c->stash->{foo} = $bar;
 354     $c->stash( { moose => 'majestic', qux => 0 } );
 355     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 356
 357     # stash is automatically passed to the view for use in a template
 358     $c->forward( 'MyApp::View::TT' );
 359
 360 =cut
 361
 362 around stash => sub {
 363     my $orig = shift;
 364     my $c = shift;
 365     if (@_) {
 366         my $stash = @_ > 1 ? {@_} : $_[0];
 367         croak('stash takes a hash or hashref') unless ref $stash;
 368         foreach my $key ( keys %$stash ) {
 369             $c->$orig()->{$key} = $stash->{$key};
 370         }
 371     }
 372     return $c->$orig();
 373 };
 374
 375 =head2 $c->error
 376
 377 =head2 $c->error($error, ...)
 378
 379 =head2 $c->error($arrayref)
 380
 381 Returns an arrayref containing error messages.  If Catalyst encounters an
 382 error while processing a request, it stores the error in $c->error.  This
 383 method should only be used to store fatal error messages.
 384
 385     my @error = @{ $c->error };
 386
 387 Add a new error.
 388
 389     $c->error('Something bad happened');
 390
 391 =cut
 392
 393 sub error {
 394     my $c = shift;
 395     if ( $_[0] ) {
 396         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 397         croak @$error unless ref $c;
 398         push @{ $c->{error} }, @$error;
 399     }
 400     elsif ( defined $_[0] ) { $c->{error} = undef }
 401     return $c->{error} || [];
 402 }
 403
 404
 405 =head2 $c->state
 406
 407 Contains the return value of the last executed action.
 408
 409 =head2 $c->clear_errors
 410
 411 Clear errors.  You probably don't want to clear the errors unless you are
 412 implementing a custom error screen.
 413
 414 This is equivalent to running
 415
 416     $c->error(0);
 417
 418 =cut
 419
 420 sub clear_errors {
 421     my $c = shift;
 422     $c->error(0);
 423 }
 424
 425
 426 # search via regex
 427 sub _comp_search {
 428     my ( $c, @names ) = @_;
 429
 430     foreach my $name (@names) {
 431         foreach my $component ( keys %{ $c->components } ) {
 432             return $c->components->{$component} if $component =~ /$name/i;
 433         }
 434     }
 435
 436     return undef;
 437 }
 438
 439 # try explicit component names
 440 sub _comp_explicit {
 441     my ( $c, @names ) = @_;
 442
 443     foreach my $try (@names) {
 444         return $c->components->{$try} if ( exists $c->components->{$try} );
 445     }
 446
 447     return undef;
 448 }
 449
 450 # like component, but try just these prefixes before regex searching,
 451 #  and do not try to return "sort keys %{ $c->components }"
 452 sub _comp_prefixes {
 453     my ( $c, $name, @prefixes ) = @_;
 454
 455     my $appclass = ref $c || $c;
 456
 457     my @names = map { "${appclass}::${_}::${name}" } @prefixes;
 458
 459     my $comp = $c->_comp_explicit(@names);
 460     return $comp if defined($comp);
 461     $comp = $c->_comp_search($name);
 462     return $comp;
 463 }
 464
 465 # Find possible names for a prefix
 466
 467 sub _comp_names {
 468     my ( $c, @prefixes ) = @_;
 469
 470     my $appclass = ref $c || $c;
 471
 472     my @pre = map { "${appclass}::${_}::" } @prefixes;
 473
 474     my @names;
 475
 476     COMPONENT: foreach my $comp ($c->component) {
 477         foreach my $p (@pre) {
 478             if ($comp =~ s/^$p//) {
 479                 push(@names, $comp);
 480                 next COMPONENT;
 481             }
 482         }
 483     }
 484
 485     return @names;
 486 }
 487
 488 # Return a component if only one matches.
 489 sub _comp_singular {
 490     my ( $c, @prefixes ) = @_;
 491
 492     my $appclass = ref $c || $c;
 493
 494     my ( $comp, $rest ) =
 495       map { $c->_comp_search("^${appclass}::${_}::") } @prefixes;
 496     return $comp unless $rest;
 497 }
 498
 499 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 500 sub _filter_component {
 501     my ( $c, $comp, @args ) = @_;
 502     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 503         return $comp->ACCEPT_CONTEXT( $c, @args );
 504     }
 505     else { return $comp }
 506 }
 507
 508 =head2 COMPONENT ACCESSORS
 509
 510 =head2 $c->controller($name)
 511
 512 Gets a L<Catalyst::Controller> instance by name.
 513
 514     $c->controller('Foo')->do_stuff;
 515
 516 If the name is omitted, will return the controller for the dispatched
 517 action.
 518
 519 =cut
 520
 521 sub controller {
 522     my ( $c, $name, @args ) = @_;
 523     return $c->_filter_component( $c->_comp_prefixes( $name, qw/Controller C/ ),
 524         @args )
 525       if ($name);
 526     return $c->component( $c->action->class );
 527 }
 528
 529 =head2 $c->model($name)
 530
 531 Gets a L<Catalyst::Model> instance by name.
 532
 533     $c->model('Foo')->do_stuff;
 534
 535 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 536
 537 If the name is omitted, it will look for
 538  - a model object in $c->stash{current_model_instance}, then
 539  - a model name in $c->stash->{current_model}, then
 540  - a config setting 'default_model', or
 541  - check if there is only one model, and return it if that's the case.
 542
 543 =cut
 544
 545 sub model {
 546     my ( $c, $name, @args ) = @_;
 547     return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
 548         @args )
 549       if $name;
 550     if (ref $c) {
 551         return $c->stash->{current_model_instance}
 552           if $c->stash->{current_model_instance};
 553         return $c->model( $c->stash->{current_model} )
 554           if $c->stash->{current_model};
 555     }
 556     return $c->model( $c->config->{default_model} )
 557       if $c->config->{default_model};
 558     return $c->_filter_component( $c->_comp_singular(qw/Model M/) );
 559
 560 }
 561
 562 =head2 $c->controllers
 563
 564 Returns the available names which can be passed to $c->controller
 565
 566 =cut
 567
 568 sub controllers {
 569     my ( $c ) = @_;
 570     return $c->_comp_names(qw/Controller C/);
 571 }
 572
 573
 574 =head2 $c->view($name)
 575
 576 Gets a L<Catalyst::View> instance by name.
 577
 578     $c->view('Foo')->do_stuff;
 579
 580 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 581
 582 If the name is omitted, it will look for
 583  - a view object in $c->stash{current_view_instance}, then
 584  - a view name in $c->stash->{current_view}, then
 585  - a config setting 'default_view', or
 586  - check if there is only one view, and return it if that's the case.
 587
 588 =cut
 589
 590 sub view {
 591     my ( $c, $name, @args ) = @_;
 592     return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
 593         @args )
 594       if $name;
 595     if (ref $c) {
 596         return $c->stash->{current_view_instance}
 597           if $c->stash->{current_view_instance};
 598         return $c->view( $c->stash->{current_view} )
 599           if $c->stash->{current_view};
 600     }
 601     return $c->view( $c->config->{default_view} )
 602       if $c->config->{default_view};
 603     return $c->_filter_component( $c->_comp_singular(qw/View V/) );
 604 }
 605
 606 =head2 $c->models
 607
 608 Returns the available names which can be passed to $c->model
 609
 610 =cut
 611
 612 sub models {
 613     my ( $c ) = @_;
 614     return $c->_comp_names(qw/Model M/);
 615 }
 616
 617
 618 =head2 $c->views
 619
 620 Returns the available names which can be passed to $c->view
 621
 622 =cut
 623
 624 sub views {
 625     my ( $c ) = @_;
 626     return $c->_comp_names(qw/View V/);
 627 }
 628
 629 =head2 $c->comp($name)
 630
 631 =head2 $c->component($name)
 632
 633 Gets a component object by name. This method is not recommended,
 634 unless you want to get a specific component by full
 635 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 636 should be used instead.
 637
 638 =cut
 639
 640 sub component {
 641     my $c = shift;
 642
 643     if (@_) {
 644
 645         my $name = shift;
 646
 647         my $appclass = ref $c || $c;
 648
 649         my @names = (
 650             $name, "${appclass}::${name}",
 651             map { "${appclass}::${_}::${name}" }
 652               qw/Model M Controller C View V/
 653         );
 654
 655         my $comp = $c->_comp_explicit(@names);
 656         return $c->_filter_component( $comp, @_ ) if defined($comp);
 657
 658         $comp = $c->_comp_search($name);
 659         return $c->_filter_component( $comp, @_ ) if defined($comp);
 660     }
 661
 662     return sort keys %{ $c->components };
 663 }
 664
 665
 666
 667 =head2 CLASS DATA AND HELPER CLASSES
 668
 669 =head2 $c->config
 670
 671 Returns or takes a hashref containing the application's configuration.
 672
 673     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 674
 675 You can also use a C<YAML>, C<XML> or C<Config::General> config file
 676 like myapp.yml in your applications home directory. See
 677 L<Catalyst::Plugin::ConfigLoader>.
 678
 679     ---
 680     db: dsn:SQLite:foo.db
 681
 682
 683 =cut
 684
 685 around config => sub {
 686     my $orig = shift;
 687     my $c = shift;
 688
 689     $c->log->warn("Setting config after setup has been run is not a good idea.")
 690       if ( @_ and $c->setup_finished );
 691
 692     $c->$orig(@_);
 693 };
 694
 695 =head2 $c->log
 696
 697 Returns the logging object instance. Unless it is already set, Catalyst
 698 sets this up with a L<Catalyst::Log> object. To use your own log class,
 699 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 700 C<< __PACKAGE__->setup >>.
 701
 702  __PACKAGE__->log( MyLogger->new );
 703  __PACKAGE__->setup;
 704
 705 And later:
 706
 707     $c->log->info( 'Now logging with my own logger!' );
 708
 709 Your log class should implement the methods described in
 710 L<Catalyst::Log>.
 711
 712
 713 =head2 $c->debug
 714
 715 Overload to enable debug messages (same as -Debug option).
 716
 717 Note that this is a static method, not an accessor and should be overloaded
 718 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
 719
 720 =cut
 721
 722 sub debug { 0 }
 723
 724 =head2 $c->dispatcher
 725
 726 Returns the dispatcher instance. Stringifies to class name. See
 727 L<Catalyst::Dispatcher>.
 728
 729 =head2 $c->engine
 730
 731 Returns the engine instance. Stringifies to the class name. See
 732 L<Catalyst::Engine>.
 733
 734
 735 =head2 UTILITY METHODS
 736
 737 =head2 $c->path_to(@path)
 738
 739 Merges C<@path> with C<< $c->config->{home} >> and returns a
 740 L<Path::Class::Dir> object.
 741
 742 For example:
 743
 744     $c->path_to( 'db', 'sqlite.db' );
 745
 746 =cut
 747
 748 sub path_to {
 749     my ( $c, @path ) = @_;
 750     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 751     if ( -d $path ) { return $path }
 752     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 753 }
 754
 755 =head2 $c->plugin( $name, $class, @args )
 756
 757 Helper method for plugins. It creates a classdata accessor/mutator and
 758 loads and instantiates the given class.
 759
 760     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 761
 762     $c->prototype->define_javascript_functions;
 763
 764 =cut
 765
 766 sub plugin {
 767     my ( $class, $name, $plugin, @args ) = @_;
 768     $class->_register_plugin( $plugin, 1 );
 769
 770     eval { $plugin->import };
 771     $class->mk_classdata($name);
 772     my $obj;
 773     eval { $obj = $plugin->new(@args) };
 774
 775     if ($@) {
 776         Catalyst::Exception->throw( message =>
 777               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 778     }
 779
 780     $class->$name($obj);
 781     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 782       if $class->debug;
 783 }
 784
 785 =head2 MyApp->setup
 786
 787 Initializes the dispatcher and engine, loads any plugins, and loads the
 788 model, view, and controller components. You may also specify an array
 789 of plugins to load here, if you choose to not load them in the C<use
 790 Catalyst> line.
 791
 792     MyApp->setup;
 793     MyApp->setup( qw/-Debug/ );
 794
 795 =cut
 796
 797 sub setup {
 798     my ( $class, @arguments ) = @_;
 799
 800     $class->log->warn("Running setup twice is not a good idea.")
 801       if ( $class->setup_finished );
 802
 803     unless ( $class->isa('Catalyst') ) {
 804
 805         Catalyst::Exception->throw(
 806             message => qq/'$class' does not inherit from Catalyst/ );
 807     }
 808
 809     if ( $class->arguments ) {
 810         @arguments = ( @arguments, @{ $class->arguments } );
 811     }
 812
 813     # Process options
 814     my $flags = {};
 815
 816     foreach (@arguments) {
 817
 818         if (/^-Debug$/) {
 819             $flags->{log} =
 820               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 821         }
 822         elsif (/^-(\w+)=?(.*)$/) {
 823             $flags->{ lc $1 } = $2;
 824         }
 825         else {
 826             push @{ $flags->{plugins} }, $_;
 827         }
 828     }
 829
 830     $class->setup_home( delete $flags->{home} );
 831
 832     $class->setup_log( delete $flags->{log} );
 833     $class->setup_plugins( delete $flags->{plugins} );
 834     $class->setup_dispatcher( delete $flags->{dispatcher} );
 835     $class->setup_engine( delete $flags->{engine} );
 836     $class->setup_stats( delete $flags->{stats} );
 837
 838     for my $flag ( sort keys %{$flags} ) {
 839
 840         if ( my $code = $class->can( 'setup_' . $flag ) ) {
 841             &$code( $class, delete $flags->{$flag} );
 842         }
 843         else {
 844             $class->log->warn(qq/Unknown flag "$flag"/);
 845         }
 846     }
 847
 848     eval { require Catalyst::Devel; };
 849     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
 850         $class->log->warn(<<"EOF");
 851 You are running an old script!
 852
 853   Please update by running (this will overwrite existing files):
 854     catalyst.pl -force -scripts $class
 855
 856   or (this will not overwrite existing files):
 857     catalyst.pl -scripts $class
 858
 859 EOF
 860     }
 861
 862     if ( $class->debug ) {
 863         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 864
 865         if (@plugins) {
 866             my $t = Text::SimpleTable->new(74);
 867             $t->row($_) for @plugins;
 868             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
 869         }
 870
 871         my $dispatcher = $class->dispatcher;
 872         my $engine     = $class->engine;
 873         my $home       = $class->config->{home};
 874
 875         $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 876         $class->log->debug(qq/Loaded engine "$engine"/);
 877
 878         $home
 879           ? ( -d $home )
 880           ? $class->log->debug(qq/Found home "$home"/)
 881           : $class->log->debug(qq/Home "$home" doesn't exist/)
 882           : $class->log->debug(q/Couldn't find home/);
 883     }
 884
 885     # Call plugins setup
 886     {
 887         no warnings qw/redefine/;
 888         local *setup = sub { };
 889         $class->setup;
 890     }
 891
 892     # Initialize our data structure
 893     $class->components( {} );
 894
 895     $class->setup_components;
 896
 897     if ( $class->debug ) {
 898         my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
 899         for my $comp ( sort keys %{ $class->components } ) {
 900             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
 901             $t->row( $comp, $type );
 902         }
 903         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
 904           if ( keys %{ $class->components } );
 905     }
 906
 907     # Add our self to components, since we are also a component
 908     $class->components->{$class} = $class;
 909
 910     $class->setup_actions;
 911
 912     if ( $class->debug ) {
 913         my $name = $class->config->{name} || 'Application';
 914         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 915     }
 916     $class->log->_flush() if $class->log->can('_flush');
 917
 918     $class->setup_finished(1);
 919 }
 920
 921 =head2 $c->uri_for( $path, @args?, \%query_values? )
 922
 923 Merges path with C<< $c->request->base >> for absolute URIs and with
 924 C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
 925 object. If any args are passed, they are added at the end of the path.
 926 If the last argument to C<uri_for> is a hash reference, it is assumed to
 927 contain GET parameter key/value pairs, which will be appended to the URI
 928 in standard fashion.
 929
 930 Note that uri_for is destructive to the passed hashref.  Subsequent calls
 931 with the same hashref may have unintended results.
 932
 933 Instead of C<$path>, you can also optionally pass a C<$action> object
 934 which will be resolved to a path using
 935 C<< $c->dispatcher->uri_for_action >>; if the first element of
 936 C<@args> is an arrayref it is treated as a list of captures to be passed
 937 to C<uri_for_action>.
 938
 939 =cut
 940
 941 sub uri_for {
 942     my ( $c, $path, @args ) = @_;
 943
 944     if ( Scalar::Util::blessed($path) ) { # action object
 945         my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
 946                          ? shift(@args)
 947                          : [] );
 948         $path = $c->dispatcher->uri_for_action($path, $captures);
 949         return undef unless defined($path);
 950         $path = '/' if $path eq '';
 951     }
 952
 953     undef($path) if (defined $path && $path eq '');
 954
 955     my $params =
 956       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 957
 958     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
 959     s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
 960
 961     unshift(@args, $path);
 962
 963     unless (defined $path && $path =~ s!^/!!) { # in-place strip
 964         my $namespace = $c->namespace;
 965         if (defined $path) { # cheesy hack to handle path '../foo'
 966            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
 967         }
 968         unshift(@args, $namespace || '');
 969     }
 970
 971     # join args with '/', or a blank string
 972     my $args = join('/', grep { defined($_) } @args);
 973     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
 974     $args =~ s!^/!!;
 975     my $base = $c->req->base;
 976     my $class = ref($base);
 977     $base =~ s{(?<!/)$}{/};
 978
 979     my $query = '';
 980
 981     if (my @keys = keys %$params) {
 982       # somewhat lifted from URI::_query's query_form
 983       $query = '?'.join('&', map {
 984           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
 985           s/ /+/g;
 986           my $key = $_;
 987           my $val = $params->{$_};
 988           $val = '' unless defined $val;
 989           (map {
 990               $_ = "$_";
 991               utf8::encode( $_ ) if utf8::is_utf8($_);
 992               # using the URI::Escape pattern here so utf8 chars survive
 993               s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
 994               s/ /+/g;
 995               "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
 996       } @keys);
 997     }
 998
 999     my $res = bless(\"${base}${args}${query}", $class);
1000     $res;
1001 }
1002
1003 =head2 $c->welcome_message
1004
1005 Returns the Catalyst welcome HTML page.
1006
1007 =cut
1008
1009 sub welcome_message {
1010     my $c      = shift;
1011     my $name   = $c->config->{name};
1012     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1013     my $prefix = Catalyst::Utils::appprefix( ref $c );
1014     $c->response->content_type('text/html; charset=utf-8');
1015     return <<"EOF";
1016 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1017     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1018 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1019     <head>
1020     <meta http-equiv="Content-Language" content="en" />
1021     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1022         <title>$name on Catalyst $VERSION</title>
1023         <style type="text/css">
1024             body {
1025                 color: #000;
1026                 background-color: #eee;
1027             }
1028             div#content {
1029                 width: 640px;
1030                 margin-left: auto;
1031                 margin-right: auto;
1032                 margin-top: 10px;
1033                 margin-bottom: 10px;
1034                 text-align: left;
1035                 background-color: #ccc;
1036                 border: 1px solid #aaa;
1037             }
1038             p, h1, h2 {
1039                 margin-left: 20px;
1040                 margin-right: 20px;
1041                 font-family: verdana, tahoma, sans-serif;
1042             }
1043             a {
1044                 font-family: verdana, tahoma, sans-serif;
1045             }
1046             :link, :visited {
1047                     text-decoration: none;
1048                     color: #b00;
1049                     border-bottom: 1px dotted #bbb;
1050             }
1051             :link:hover, :visited:hover {
1052                     color: #555;
1053             }
1054             div#topbar {
1055                 margin: 0px;
1056             }
1057             pre {
1058                 margin: 10px;
1059                 padding: 8px;
1060             }
1061             div#answers {
1062                 padding: 8px;
1063                 margin: 10px;
1064                 background-color: #fff;
1065                 border: 1px solid #aaa;
1066             }
1067             h1 {
1068                 font-size: 0.9em;
1069                 font-weight: normal;
1070                 text-align: center;
1071             }
1072             h2 {
1073                 font-size: 1.0em;
1074             }
1075             p {
1076                 font-size: 0.9em;
1077             }
1078             p img {
1079                 float: right;
1080                 margin-left: 10px;
1081             }
1082             span#appname {
1083                 font-weight: bold;
1084                 font-size: 1.6em;
1085             }
1086         </style>
1087     </head>
1088     <body>
1089         <div id="content">
1090             <div id="topbar">
1091                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1092                     $VERSION</h1>
1093              </div>
1094              <div id="answers">
1095                  <p>
1096                  <img src="$logo" alt="Catalyst Logo" />
1097                  </p>
1098                  <p>Welcome to the  world of Catalyst.
1099                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1100                     framework will make web development something you had
1101                     never expected it to be: Fun, rewarding, and quick.</p>
1102                  <h2>What to do now?</h2>
1103                  <p>That really depends  on what <b>you</b> want to do.
1104                     We do, however, provide you with a few starting points.</p>
1105                  <p>If you want to jump right into web development with Catalyst
1106                     you might want want to start with a tutorial.</p>
1107 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1108 </pre>
1109 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1110 <pre>
1111 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1112 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1113 </code></pre>
1114                  <h2>What to do next?</h2>
1115                  <p>Next it's time to write an actual application. Use the
1116                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1117                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1118                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1119                     they can save you a lot of work.</p>
1120                     <pre><code>script/${prefix}_create.pl -help</code></pre>
1121                     <p>Also, be sure to check out the vast and growing
1122                     collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
1123                     you are likely to find what you need there.
1124                     </p>
1125
1126                  <h2>Need help?</h2>
1127                  <p>Catalyst has a very active community. Here are the main places to
1128                     get in touch with us.</p>
1129                  <ul>
1130                      <li>
1131                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1132                      </li>
1133                      <li>
1134                          <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
1135                      </li>
1136                      <li>
1137                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1138                      </li>
1139                  </ul>
1140                  <h2>In conclusion</h2>
1141                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1142                     as we enjoyed making it. Please contact us if you have ideas
1143                     for improvement or other feedback.</p>
1144              </div>
1145          </div>
1146     </body>
1147 </html>
1148 EOF
1149 }
1150
1151 =head1 INTERNAL METHODS
1152
1153 These methods are not meant to be used by end users.
1154
1155 =head2 $c->components
1156
1157 Returns a hash of components.
1158
1159 =head2 $c->context_class
1160
1161 Returns or sets the context class.
1162
1163 =head2 $c->counter
1164
1165 Returns a hashref containing coderefs and execution counts (needed for
1166 deep recursion detection).
1167
1168 =head2 $c->depth
1169
1170 Returns the number of actions on the current internal execution stack.
1171
1172 =head2 $c->dispatch
1173
1174 Dispatches a request to actions.
1175
1176 =cut
1177
1178 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1179
1180 =head2 $c->dispatcher_class
1181
1182 Returns or sets the dispatcher class.
1183
1184 =head2 $c->dump_these
1185
1186 Returns a list of 2-element array references (name, structure) pairs
1187 that will be dumped on the error page in debug mode.
1188
1189 =cut
1190
1191 sub dump_these {
1192     my $c = shift;
1193     [ Request => $c->req ],
1194     [ Response => $c->res ],
1195     [ Stash => $c->stash ],
1196     [ Config => $c->config ];
1197 }
1198
1199 =head2 $c->engine_class
1200
1201 Returns or sets the engine class.
1202
1203 =head2 $c->execute( $class, $coderef )
1204
1205 Execute a coderef in given class and catch exceptions. Errors are available
1206 via $c->error.
1207
1208 =cut
1209
1210 sub execute {
1211     my ( $c, $class, $code ) = @_;
1212     $class = $c->component($class) || $class;
1213     $c->state(0);
1214
1215     if ( $c->depth >= $RECURSION ) {
1216         my $action = "$code";
1217         $action = "/$action" unless $action =~ /->/;
1218         my $error = qq/Deep recursion detected calling "$action"/;
1219         $c->log->error($error);
1220         $c->error($error);
1221         $c->state(0);
1222         return $c->state;
1223     }
1224
1225     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1226
1227     push( @{ $c->stack }, $code );
1228
1229     eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
1230
1231     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1232
1233     my $last = pop( @{ $c->stack } );
1234
1235     if ( my $error = $@ ) {
1236         if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
1237         else {
1238             unless ( ref $error ) {
1239                 no warnings 'uninitialized';
1240                 chomp $error;
1241                 my $class = $last->class;
1242                 my $name  = $last->name;
1243                 $error = qq/Caught exception in $class->$name "$error"/;
1244             }
1245             $c->error($error);
1246             $c->state(0);
1247         }
1248     }
1249     return $c->state;
1250 }
1251
1252 sub _stats_start_execute {
1253     my ( $c, $code ) = @_;
1254
1255     return if ( ( $code->name =~ /^_.*/ )
1256         && ( !$c->config->{show_internal_actions} ) );
1257
1258     $c->counter->{"$code"}++;
1259
1260     my $action = "$code";
1261     $action = "/$action" unless $action =~ /->/;
1262
1263     # determine if the call was the result of a forward
1264     # this is done by walking up the call stack and looking for a calling
1265     # sub of Catalyst::forward before the eval
1266     my $callsub = q{};
1267     for my $index ( 2 .. 11 ) {
1268         last
1269         if ( ( caller($index) )[0] eq 'Catalyst'
1270             && ( caller($index) )[3] eq '(eval)' );
1271
1272         if ( ( caller($index) )[3] =~ /forward$/ ) {
1273             $callsub = ( caller($index) )[3];
1274             $action  = "-> $action";
1275             last;
1276         }
1277     }
1278
1279     my $uid = "$code" . $c->counter->{"$code"};
1280
1281     # is this a root-level call or a forwarded call?
1282     if ( $callsub =~ /forward$/ ) {
1283
1284         # forward, locate the caller
1285         if ( my $parent = $c->stack->[-1] ) {
1286             $c->stats->profile(
1287                 begin  => $action,
1288                 parent => "$parent" . $c->counter->{"$parent"},
1289                 uid    => $uid,
1290             );
1291         }
1292         else {
1293
1294             # forward with no caller may come from a plugin
1295             $c->stats->profile(
1296                 begin => $action,
1297                 uid   => $uid,
1298             );
1299         }
1300     }
1301     else {
1302
1303         # root-level call
1304         $c->stats->profile(
1305             begin => $action,
1306             uid   => $uid,
1307         );
1308     }
1309     return $action;
1310
1311 }
1312
1313 sub _stats_finish_execute {
1314     my ( $c, $info ) = @_;
1315     $c->stats->profile( end => $info );
1316 }
1317
1318 =head2 $c->_localize_fields( sub { }, \%keys );
1319
1320 =cut
1321
1322 sub _localize_fields {
1323     my ( $c, $localized, $code ) = ( @_ );
1324
1325     my $request = delete $localized->{request} || {};
1326     my $response = delete $localized->{response} || {};
1327
1328     local @{ $c }{ keys %$localized } = values %$localized;
1329     local @{ $c->request }{ keys %$request } = values %$request;
1330     local @{ $c->response }{ keys %$response } = values %$response;
1331
1332     $code->();
1333 }
1334
1335 =head2 $c->finalize
1336
1337 Finalizes the request.
1338
1339 =cut
1340
1341 sub finalize {
1342     my $c = shift;
1343
1344     for my $error ( @{ $c->error } ) {
1345         $c->log->error($error);
1346     }
1347
1348     # Allow engine to handle finalize flow (for POE)
1349     if ( $c->engine->can('finalize') ) {
1350         $c->engine->finalize($c);
1351     }
1352     else {
1353
1354         $c->finalize_uploads;
1355
1356         # Error
1357         if ( $#{ $c->error } >= 0 ) {
1358             $c->finalize_error;
1359         }
1360
1361         $c->finalize_headers;
1362
1363         # HEAD request
1364         if ( $c->request->method eq 'HEAD' ) {
1365             $c->response->body('');
1366         }
1367
1368         $c->finalize_body;
1369     }
1370
1371     if ($c->use_stats) {
1372         my $elapsed = sprintf '%f', $c->stats->elapsed;
1373         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1374         $c->log->info(
1375             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1376     }
1377
1378     return $c->response->status;
1379 }
1380
1381 =head2 $c->finalize_body
1382
1383 Finalizes body.
1384
1385 =cut
1386
1387 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1388
1389 =head2 $c->finalize_cookies
1390
1391 Finalizes cookies.
1392
1393 =cut
1394
1395 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1396
1397 =head2 $c->finalize_error
1398
1399 Finalizes error.
1400
1401 =cut
1402
1403 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1404
1405 =head2 $c->finalize_headers
1406
1407 Finalizes headers.
1408
1409 =cut
1410
1411 sub finalize_headers {
1412     my $c = shift;
1413
1414     # Check if we already finalized headers
1415     return if $c->response->{_finalized_headers};
1416
1417     # Handle redirects
1418     if ( my $location = $c->response->redirect ) {
1419         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1420         $c->response->header( Location => $location );
1421
1422         if ( !$c->response->body ) {
1423             # Add a default body if none is already present
1424             $c->response->body(
1425                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1426             );
1427         }
1428     }
1429
1430     # Content-Length
1431     if ( $c->response->body && !$c->response->content_length ) {
1432
1433         # get the length from a filehandle
1434         if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1435         {
1436             my $stat = stat $c->response->body;
1437             if ( $stat && $stat->size > 0 ) {
1438                 $c->response->content_length( $stat->size );
1439             }
1440             else {
1441                 $c->log->warn('Serving filehandle without a content-length');
1442             }
1443         }
1444         else {
1445             # everything should be bytes at this point, but just in case
1446             $c->response->content_length( bytes::length( $c->response->body ) );
1447         }
1448     }
1449
1450     # Errors
1451     if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1452         $c->response->headers->remove_header("Content-Length");
1453         $c->response->body('');
1454     }
1455
1456     $c->finalize_cookies;
1457
1458     $c->engine->finalize_headers( $c, @_ );
1459
1460     # Done
1461     $c->response->{_finalized_headers} = 1;
1462 }
1463
1464 =head2 $c->finalize_output
1465
1466 An alias for finalize_body.
1467
1468 =head2 $c->finalize_read
1469
1470 Finalizes the input after reading is complete.
1471
1472 =cut
1473
1474 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1475
1476 =head2 $c->finalize_uploads
1477
1478 Finalizes uploads. Cleans up any temporary files.
1479
1480 =cut
1481
1482 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1483
1484 =head2 $c->get_action( $action, $namespace )
1485
1486 Gets an action in a given namespace.
1487
1488 =cut
1489
1490 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1491
1492 =head2 $c->get_actions( $action, $namespace )
1493
1494 Gets all actions of a given name in a namespace and all parent
1495 namespaces.
1496
1497 =cut
1498
1499 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1500
1501 =head2 $c->handle_request( $class, @arguments )
1502
1503 Called to handle each HTTP request.
1504
1505 =cut
1506
1507 sub handle_request {
1508     my ( $class, @arguments ) = @_;
1509
1510     # Always expect worst case!
1511     my $status = -1;
1512     eval {
1513         if ($class->debug) {
1514             my $secs = time - $START || 1;
1515             my $av = sprintf '%.3f', $COUNT / $secs;
1516             my $time = localtime time;
1517             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1518         }
1519
1520         my $c = $class->prepare(@arguments);
1521         $c->dispatch;
1522         $status = $c->finalize;
1523     };
1524
1525     if ( my $error = $@ ) {
1526         chomp $error;
1527         $class->log->error(qq/Caught exception in engine "$error"/);
1528     }
1529
1530     $COUNT++;
1531     $class->log->_flush() if $class->log->can('_flush');
1532     return $status;
1533 }
1534
1535 =head2 $c->prepare( @arguments )
1536
1537 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1538 etc.).
1539
1540 =cut
1541
1542 sub prepare {
1543     my ( $class, @arguments ) = @_;
1544
1545     $class->context_class( ref $class || $class ) unless $class->context_class;
1546     my $c = $class->context_class->new(
1547         {
1548             counter => {},
1549             stack   => [],
1550             request => $class->request_class->new(
1551                 {
1552                     arguments        => [],
1553                     body_parameters  => {},
1554                     cookies          => {},
1555                     headers          => HTTP::Headers->new,
1556                     parameters       => {},
1557                     query_parameters => {},
1558                     secure           => 0,
1559                     captures         => [],
1560                     uploads          => {}
1561                 }
1562             ),
1563             response => $class->response_class->new(
1564                 {
1565                     body    => '',
1566                     cookies => {},
1567                     headers => HTTP::Headers->new(),
1568                     status  => 200
1569                 }
1570             ),
1571             stash => {},
1572             state => 0
1573         }
1574     );
1575
1576     $c->stats($class->stats_class->new)->enable($c->use_stats);
1577     if ( $c->debug ) {
1578         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1579     }
1580
1581     # For on-demand data
1582     $c->request->_context($c);
1583     $c->response->_context($c);
1584
1585     # Allow engine to direct the prepare flow (for POE)
1586     if ( $c->engine->can('prepare') ) {
1587         $c->engine->prepare( $c, @arguments );
1588     }
1589     else {
1590         $c->prepare_request(@arguments);
1591         $c->prepare_connection;
1592         $c->prepare_query_parameters;
1593         $c->prepare_headers;
1594         $c->prepare_cookies;
1595         $c->prepare_path;
1596
1597         # Prepare the body for reading, either by prepare_body
1598         # or the user, if they are using $c->read
1599         $c->prepare_read;
1600
1601         # Parse the body unless the user wants it on-demand
1602         unless ( $c->config->{parse_on_demand} ) {
1603             $c->prepare_body;
1604         }
1605     }
1606
1607     my $method  = $c->req->method  || '';
1608     my $path    = $c->req->path    || '/';
1609     my $address = $c->req->address || '';
1610
1611     $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1612       if $c->debug;
1613
1614     $c->prepare_action;
1615
1616     return $c;
1617 }
1618
1619 =head2 $c->prepare_action
1620
1621 Prepares action. See L<Catalyst::Dispatcher>.
1622
1623 =cut
1624
1625 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1626
1627 =head2 $c->prepare_body
1628
1629 Prepares message body.
1630
1631 =cut
1632
1633 sub prepare_body {
1634     my $c = shift;
1635
1636     # Do we run for the first time?
1637     return if defined $c->request->{_body};
1638
1639     # Initialize on-demand data
1640     $c->engine->prepare_body( $c, @_ );
1641     $c->prepare_parameters;
1642     $c->prepare_uploads;
1643
1644     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1645         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1646         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1647             my $param = $c->req->body_parameters->{$key};
1648             my $value = defined($param) ? $param : '';
1649             $t->row( $key,
1650                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1651         }
1652         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1653     }
1654 }
1655
1656 =head2 $c->prepare_body_chunk( $chunk )
1657
1658 Prepares a chunk of data before sending it to L<HTTP::Body>.
1659
1660 See L<Catalyst::Engine>.
1661
1662 =cut
1663
1664 sub prepare_body_chunk {
1665     my $c = shift;
1666     $c->engine->prepare_body_chunk( $c, @_ );
1667 }
1668
1669 =head2 $c->prepare_body_parameters
1670
1671 Prepares body parameters.
1672
1673 =cut
1674
1675 sub prepare_body_parameters {
1676     my $c = shift;
1677     $c->engine->prepare_body_parameters( $c, @_ );
1678 }
1679
1680 =head2 $c->prepare_connection
1681
1682 Prepares connection.
1683
1684 =cut
1685
1686 sub prepare_connection {
1687     my $c = shift;
1688     $c->engine->prepare_connection( $c, @_ );
1689 }
1690
1691 =head2 $c->prepare_cookies
1692
1693 Prepares cookies.
1694
1695 =cut
1696
1697 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1698
1699 =head2 $c->prepare_headers
1700
1701 Prepares headers.
1702
1703 =cut
1704
1705 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1706
1707 =head2 $c->prepare_parameters
1708
1709 Prepares parameters.
1710
1711 =cut
1712
1713 sub prepare_parameters {
1714     my $c = shift;
1715     $c->prepare_body_parameters;
1716     $c->engine->prepare_parameters( $c, @_ );
1717 }
1718
1719 =head2 $c->prepare_path
1720
1721 Prepares path and base.
1722
1723 =cut
1724
1725 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1726
1727 =head2 $c->prepare_query_parameters
1728
1729 Prepares query parameters.
1730
1731 =cut
1732
1733 sub prepare_query_parameters {
1734     my $c = shift;
1735
1736     $c->engine->prepare_query_parameters( $c, @_ );
1737
1738     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1739         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1740         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1741             my $param = $c->req->query_parameters->{$key};
1742             my $value = defined($param) ? $param : '';
1743             $t->row( $key,
1744                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1745         }
1746         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1747     }
1748 }
1749
1750 =head2 $c->prepare_read
1751
1752 Prepares the input for reading.
1753
1754 =cut
1755
1756 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1757
1758 =head2 $c->prepare_request
1759
1760 Prepares the engine request.
1761
1762 =cut
1763
1764 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1765
1766 =head2 $c->prepare_uploads
1767
1768 Prepares uploads.
1769
1770 =cut
1771
1772 sub prepare_uploads {
1773     my $c = shift;
1774
1775     $c->engine->prepare_uploads( $c, @_ );
1776
1777     if ( $c->debug && keys %{ $c->request->uploads } ) {
1778         my $t = Text::SimpleTable->new(
1779             [ 12, 'Parameter' ],
1780             [ 26, 'Filename' ],
1781             [ 18, 'Type' ],
1782             [ 9,  'Size' ]
1783         );
1784         for my $key ( sort keys %{ $c->request->uploads } ) {
1785             my $upload = $c->request->uploads->{$key};
1786             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1787                 $t->row( $key, $u->filename, $u->type, $u->size );
1788             }
1789         }
1790         $c->log->debug( "File Uploads are:\n" . $t->draw );
1791     }
1792 }
1793
1794 =head2 $c->prepare_write
1795
1796 Prepares the output for writing.
1797
1798 =cut
1799
1800 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1801
1802 =head2 $c->request_class
1803
1804 Returns or sets the request class.
1805
1806 =head2 $c->response_class
1807
1808 Returns or sets the response class.
1809
1810 =head2 $c->read( [$maxlength] )
1811
1812 Reads a chunk of data from the request body. This method is designed to
1813 be used in a while loop, reading C<$maxlength> bytes on every call.
1814 C<$maxlength> defaults to the size of the request if not specified.
1815
1816 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1817 directly.
1818
1819 Warning: If you use read(), Catalyst will not process the body,
1820 so you will not be able to access POST parameters or file uploads via
1821 $c->request.  You must handle all body parsing yourself.
1822
1823 =cut
1824
1825 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1826
1827 =head2 $c->run
1828
1829 Starts the engine.
1830
1831 =cut
1832
1833 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1834
1835 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1836
1837 Sets an action in a given namespace.
1838
1839 =cut
1840
1841 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1842
1843 =head2 $c->setup_actions($component)
1844
1845 Sets up actions for a component.
1846
1847 =cut
1848
1849 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1850
1851 =head2 $c->setup_components
1852
1853 Sets up components. Specify a C<setup_components> config option to pass
1854 additional options directly to L<Module::Pluggable>. To add additional
1855 search paths, specify a key named C<search_extra> as an array
1856 reference. Items in the array beginning with C<::> will have the
1857 application class name prepended to them.
1858
1859 =cut
1860
1861 sub setup_components {
1862     my $class = shift;
1863
1864     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
1865     my $config  = $class->config->{ setup_components };
1866     my $extra   = delete $config->{ search_extra } || [];
1867
1868     push @paths, @$extra;
1869
1870     my $locator = Module::Pluggable::Object->new(
1871         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1872         %$config
1873     );
1874
1875     my @comps = sort { length $a <=> length $b } $locator->plugins;
1876     my %comps = map { $_ => 1 } @comps;
1877
1878     for my $component ( @comps ) {
1879
1880         # We pass ignore_loaded here so that overlay files for (e.g.)
1881         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
1882         # we know M::P::O found a file on disk so this is safe
1883
1884         #Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1885         Class::MOP::load_class($component);
1886
1887         my $module  = $class->setup_component( $component );
1888         my %modules = (
1889             $component => $module,
1890             map {
1891                 $_ => $class->setup_component( $_ )
1892             } grep {
1893               not exists $comps{$_}
1894             } Devel::InnerPackage::list_packages( $component )
1895         );
1896
1897         for my $key ( keys %modules ) {
1898             $class->components->{ $key } = $modules{ $key };
1899         }
1900     }
1901 }
1902
1903 =head2 $c->setup_component
1904
1905 =cut
1906
1907 sub setup_component {
1908     my( $class, $component ) = @_;
1909
1910     unless ( $component->can( 'COMPONENT' ) ) {
1911         return $component;
1912     }
1913
1914     my $suffix = Catalyst::Utils::class2classsuffix( $component );
1915     my $config = $class->config->{ $suffix } || {};
1916
1917     my $instance = eval { $component->COMPONENT( $class, $config ); };
1918
1919     if ( my $error = $@ ) {
1920         chomp $error;
1921         Catalyst::Exception->throw(
1922             message => qq/Couldn't instantiate component "$component", "$error"/
1923         );
1924     }
1925
1926     Catalyst::Exception->throw(
1927         message =>
1928         qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
1929     ) unless eval { $instance->can( 'can' ) };
1930
1931     return $instance;
1932 }
1933
1934 =head2 $c->setup_dispatcher
1935
1936 Sets up dispatcher.
1937
1938 =cut
1939
1940 sub setup_dispatcher {
1941     my ( $class, $dispatcher ) = @_;
1942
1943     if ($dispatcher) {
1944         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1945     }
1946
1947     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
1948         $dispatcher = 'Catalyst::Dispatcher::' . $env;
1949     }
1950
1951     unless ($dispatcher) {
1952         $dispatcher = $class->dispatcher_class;
1953     }
1954
1955     unless (Class::Inspector->loaded($dispatcher)) {
1956         require Class::Inspector->filename($dispatcher);
1957     }
1958
1959     # dispatcher instance
1960     $class->dispatcher( $dispatcher->new );
1961 }
1962
1963 =head2 $c->setup_engine
1964
1965 Sets up engine.
1966
1967 =cut
1968
1969 sub setup_engine {
1970     my ( $class, $engine ) = @_;
1971
1972     if ($engine) {
1973         $engine = 'Catalyst::Engine::' . $engine;
1974     }
1975
1976     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
1977         $engine = 'Catalyst::Engine::' . $env;
1978     }
1979
1980     if ( $ENV{MOD_PERL} ) {
1981
1982         # create the apache method
1983         {
1984             no strict 'refs';
1985             *{"$class\::apache"} = sub { shift->engine->apache };
1986         }
1987
1988         my ( $software, $version ) =
1989           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1990
1991         $version =~ s/_//g;
1992         $version =~ s/(\.[^.]+)\./$1/g;
1993
1994         if ( $software eq 'mod_perl' ) {
1995
1996             if ( !$engine ) {
1997
1998                 if ( $version >= 1.99922 ) {
1999                     $engine = 'Catalyst::Engine::Apache2::MP20';
2000                 }
2001
2002                 elsif ( $version >= 1.9901 ) {
2003                     $engine = 'Catalyst::Engine::Apache2::MP19';
2004                 }
2005
2006                 elsif ( $version >= 1.24 ) {
2007                     $engine = 'Catalyst::Engine::Apache::MP13';
2008                 }
2009
2010                 else {
2011                     Catalyst::Exception->throw( message =>
2012                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2013                 }
2014
2015             }
2016
2017             # install the correct mod_perl handler
2018             if ( $version >= 1.9901 ) {
2019                 *handler = sub  : method {
2020                     shift->handle_request(@_);
2021                 };
2022             }
2023             else {
2024                 *handler = sub ($$) { shift->handle_request(@_) };
2025             }
2026
2027         }
2028
2029         elsif ( $software eq 'Zeus-Perl' ) {
2030             $engine = 'Catalyst::Engine::Zeus';
2031         }
2032
2033         else {
2034             Catalyst::Exception->throw(
2035                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2036         }
2037     }
2038
2039     unless ($engine) {
2040         $engine = $class->engine_class;
2041     }
2042
2043     unless (Class::Inspector->loaded($engine)) {
2044         require Class::Inspector->filename($engine);
2045     }
2046
2047     # check for old engines that are no longer compatible
2048     my $old_engine;
2049     if ( $engine->isa('Catalyst::Engine::Apache')
2050         && !Catalyst::Engine::Apache->VERSION )
2051     {
2052         $old_engine = 1;
2053     }
2054
2055     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2056         && Catalyst::Engine::Server->VERSION le '0.02' )
2057     {
2058         $old_engine = 1;
2059     }
2060
2061     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2062         && $engine->VERSION eq '0.01' )
2063     {
2064         $old_engine = 1;
2065     }
2066
2067     elsif ($engine->isa('Catalyst::Engine::Zeus')
2068         && $engine->VERSION eq '0.01' )
2069     {
2070         $old_engine = 1;
2071     }
2072
2073     if ($old_engine) {
2074         Catalyst::Exception->throw( message =>
2075               qq/Engine "$engine" is not supported by this version of Catalyst/
2076         );
2077     }
2078
2079     # engine instance
2080     $class->engine( $engine->new );
2081 }
2082
2083 =head2 $c->setup_home
2084
2085 Sets up the home directory.
2086
2087 =cut
2088
2089 sub setup_home {
2090     my ( $class, $home ) = @_;
2091
2092     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2093         $home = $env;
2094     }
2095
2096     unless ($home) {
2097         $home = Catalyst::Utils::home($class);
2098     }
2099
2100     if ($home) {
2101         $class->config->{home} ||= $home;
2102         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2103     }
2104 }
2105
2106 =head2 $c->setup_log
2107
2108 Sets up log.
2109
2110 =cut
2111
2112 sub setup_log {
2113     my ( $class, $debug ) = @_;
2114
2115     unless ( $class->log ) {
2116         $class->log( Catalyst::Log->new );
2117     }
2118
2119     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2120     if ( defined($env_debug) ? $env_debug : $debug ) {
2121         no strict 'refs';
2122         *{"$class\::debug"} = sub { 1 };
2123         $class->log->debug('Debug messages enabled');
2124     }
2125 }
2126
2127 =head2 $c->setup_plugins
2128
2129 Sets up plugins.
2130
2131 =cut
2132
2133 =head2 $c->setup_stats
2134
2135 Sets up timing statistics class.
2136
2137 =cut
2138
2139 sub setup_stats {
2140     my ( $class, $stats ) = @_;
2141
2142     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2143
2144     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2145     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2146         no strict 'refs';
2147         *{"$class\::use_stats"} = sub { 1 };
2148         $class->log->debug('Statistics enabled');
2149     }
2150 }
2151
2152
2153 =head2 $c->registered_plugins
2154
2155 Returns a sorted list of the plugins which have either been stated in the
2156 import list or which have been added via C<< MyApp->plugin(@args); >>.
2157
2158 If passed a given plugin name, it will report a boolean value indicating
2159 whether or not that plugin is loaded.  A fully qualified name is required if
2160 the plugin name does not begin with C<Catalyst::Plugin::>.
2161
2162  if ($c->registered_plugins('Some::Plugin')) {
2163      ...
2164  }
2165
2166 =cut
2167
2168 {
2169
2170     sub registered_plugins {
2171         my $proto = shift;
2172         return sort keys %{ $proto->_plugins } unless @_;
2173         my $plugin = shift;
2174         return 1 if exists $proto->_plugins->{$plugin};
2175         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2176     }
2177
2178     sub _register_plugin {
2179         my ( $proto, $plugin, $instant ) = @_;
2180         my $class = ref $proto || $proto;
2181
2182         # no ignore_loaded here, the plugin may already have been
2183         # defined in memory and we don't want to error on "no file" if so
2184
2185         Catalyst::Utils::ensure_class_loaded( $plugin );
2186
2187         $proto->_plugins->{$plugin} = 1;
2188         unless ($instant) {
2189             no strict 'refs';
2190             if( $class->can('meta') ){
2191               my @superclasses = ($plugin, $class->meta->superclasses );
2192               $class->meta->superclasses(@superclasses);
2193             } else {
2194               unshift @{"$class\::ISA"}, $plugin;
2195             }
2196         }
2197         return $class;
2198     }
2199
2200     sub setup_plugins {
2201         my ( $class, $plugins ) = @_;
2202
2203         $class->_plugins( {} ) unless $class->_plugins;
2204         $plugins ||= [];
2205         for my $plugin ( reverse @$plugins ) {
2206
2207             unless ( $plugin =~ s/\A\+// ) {
2208                 $plugin = "Catalyst::Plugin::$plugin";
2209             }
2210
2211             $class->_register_plugin($plugin);
2212         }
2213     }
2214 }
2215
2216 =head2 $c->stack
2217
2218 Returns an arrayref of the internal execution stack (actions that are
2219 currently executing).
2220
2221 =head2 $c->stats_class
2222
2223 Returns or sets the stats (timing statistics) class.
2224
2225 =head2 $c->use_stats
2226
2227 Returns 1 when stats collection is enabled.  Stats collection is enabled
2228 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2229 environment variable is set.
2230
2231 Note that this is a static method, not an accessor and should be overloaded
2232 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2233
2234 =cut
2235
2236 sub use_stats { 0 }
2237
2238
2239 =head2 $c->write( $data )
2240
2241 Writes $data to the output stream. When using this method directly, you
2242 will need to manually set the C<Content-Length> header to the length of
2243 your output data, if known.
2244
2245 =cut
2246
2247 sub write {
2248     my $c = shift;
2249
2250     # Finalize headers if someone manually writes output
2251     $c->finalize_headers;
2252
2253     return $c->engine->write( $c, @_ );
2254 }
2255
2256 =head2 version
2257
2258 Returns the Catalyst version number. Mostly useful for "powered by"
2259 messages in template systems.
2260
2261 =cut
2262
2263 sub version { return $Catalyst::VERSION }
2264
2265 =head1 INTERNAL ACTIONS
2266
2267 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2268 C<_ACTION>, and C<_END>. These are by default not shown in the private
2269 action table, but you can make them visible with a config parameter.
2270
2271     MyApp->config->{show_internal_actions} = 1;
2272
2273 =head1 CASE SENSITIVITY
2274
2275 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2276 mapped to C</foo/bar>. You can activate case sensitivity with a config
2277 parameter.
2278
2279     MyApp->config->{case_sensitive} = 1;
2280
2281 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2282
2283 =head1 ON-DEMAND PARSER
2284
2285 The request body is usually parsed at the beginning of a request,
2286 but if you want to handle input yourself, you can enable on-demand
2287 parsing with a config parameter.
2288
2289     MyApp->config->{parse_on_demand} = 1;
2290
2291 =head1 PROXY SUPPORT
2292
2293 Many production servers operate using the common double-server approach,
2294 with a lightweight frontend web server passing requests to a larger
2295 backend server. An application running on the backend server must deal
2296 with two problems: the remote user always appears to be C<127.0.0.1> and
2297 the server's hostname will appear to be C<localhost> regardless of the
2298 virtual host that the user connected through.
2299
2300 Catalyst will automatically detect this situation when you are running
2301 the frontend and backend servers on the same machine. The following
2302 changes are made to the request.
2303
2304     $c->req->address is set to the user's real IP address, as read from
2305     the HTTP X-Forwarded-For header.
2306
2307     The host value for $c->req->base and $c->req->uri is set to the real
2308     host, as read from the HTTP X-Forwarded-Host header.
2309
2310 Obviously, your web server must support these headers for this to work.
2311
2312 In a more complex server farm environment where you may have your
2313 frontend proxy server(s) on different machines, you will need to set a
2314 configuration option to tell Catalyst to read the proxied data from the
2315 headers.
2316
2317     MyApp->config->{using_frontend_proxy} = 1;
2318
2319 If you do not wish to use the proxy support at all, you may set:
2320
2321     MyApp->config->{ignore_frontend_proxy} = 1;
2322
2323 =head1 THREAD SAFETY
2324
2325 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2326 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2327 believe the Catalyst core to be thread-safe.
2328
2329 If you plan to operate in a threaded environment, remember that all other
2330 modules you are using must also be thread-safe. Some modules, most notably
2331 L<DBD::SQLite>, are not thread-safe.
2332
2333 =head1 SUPPORT
2334
2335 IRC:
2336
2337     Join #catalyst on irc.perl.org.
2338
2339 Mailing Lists:
2340
2341     http://lists.rawmode.org/mailman/listinfo/catalyst
2342     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
2343
2344 Web:
2345
2346     http://catalyst.perl.org
2347
2348 Wiki:
2349
2350     http://dev.catalyst.perl.org
2351
2352 =head1 SEE ALSO
2353
2354 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2355
2356 =head2 L<Catalyst::Manual> - The Catalyst Manual
2357
2358 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2359
2360 =head2 L<Catalyst::Engine> - Core engine
2361
2362 =head2 L<Catalyst::Log> - Log class.
2363
2364 =head2 L<Catalyst::Request> - Request object
2365
2366 =head2 L<Catalyst::Response> - Response object
2367
2368 =head2 L<Catalyst::Test> - The test suite.
2369
2370 =head1 CREDITS
2371
2372 Andy Grundman
2373
2374 Andy Wardley
2375
2376 Andreas Marienborg
2377
2378 Andrew Bramble
2379
2380 Andrew Ford
2381
2382 Andrew Ruthven
2383
2384 Arthur Bergman
2385
2386 Autrijus Tang
2387
2388 Brian Cassidy
2389
2390 Carl Franks
2391
2392 Christian Hansen
2393
2394 Christopher Hicks
2395
2396 Dan Sully
2397
2398 Danijel Milicevic
2399
2400 David Kamholz
2401
2402 David Naughton
2403
2404 Drew Taylor
2405
2406 Gary Ashton Jones
2407
2408 Geoff Richards
2409
2410 Jesse Sheidlower
2411
2412 Jesse Vincent
2413
2414 Jody Belka
2415
2416 Johan Lindstrom
2417
2418 Juan Camacho
2419
2420 Leon Brocard
2421
2422 Marcus Ramberg
2423
2424 Matt S Trout
2425
2426 Robert Sedlacek
2427
2428 Sam Vilain
2429
2430 Sascha Kiefer
2431
2432 Sebastian Willert
2433
2434 Tatsuhiko Miyagawa
2435
2436 Ulf Edvinsson
2437
2438 Yuval Kogman
2439
2440 =head1 AUTHOR
2441
2442 Sebastian Riedel, C<sri@oook.de>
2443
2444 =head1 LICENSE
2445
2446 This library is free software, you can redistribute it and/or modify it under
2447 the same terms as Perl itself.
2448
2449 =cut
2450
2451 1;