lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use strict;
   4 use base 'Catalyst::Base';
   5 use bytes;
   6 use UNIVERSAL::require;
   7 use Catalyst::Exception;
   8 use Catalyst::Log;
   9 use Catalyst::Request;
  10 use Catalyst::Request::Upload;
  11 use Catalyst::Response;
  12 use Catalyst::Utils;
  13 use NEXT;
  14 use Text::ASCIITable;
  15 use Path::Class;
  16 use Time::HiRes qw/gettimeofday tv_interval/;
  17 use URI;
  18 use Scalar::Util qw/weaken/;
  19
  20 __PACKAGE__->mk_accessors(
  21     qw/counter depth request response state action namespace/
  22 );
  23
  24 # Laziness++
  25 *comp = \&component;
  26 *req  = \&request;
  27 *res  = \&response;
  28
  29 # For backwards compatibility
  30 *finalize_output = \&finalize_body;
  31
  32 # For statistics
  33 our $COUNT     = 1;
  34 our $START     = time;
  35 our $RECURSION = 1000;
  36 our $DETACH    = "catalyst_detach\n";
  37
  38 require Module::Pluggable::Fast;
  39
  40 # Helper script generation
  41 our $CATALYST_SCRIPT_GEN = 9;
  42
  43 __PACKAGE__->mk_classdata($_)
  44   for qw/components arguments dispatcher engine log/;
  45
  46 our $VERSION = '5.49_02';
  47
  48 sub import {
  49     my ( $class, @arguments ) = @_;
  50
  51     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  52     # callers @ISA.
  53     return unless $class eq 'Catalyst';
  54
  55     my $caller = caller(0);
  56
  57     unless ( $caller->isa('Catalyst') ) {
  58         no strict 'refs';
  59         push @{"$caller\::ISA"}, $class;
  60     }
  61
  62     $caller->arguments( [@arguments] );
  63     $caller->setup_home;
  64 }
  65
  66 =head1 NAME
  67
  68 Catalyst - The Elegant MVC Web Application Framework
  69
  70 =head1 SYNOPSIS
  71
  72     # use the helper to start a new application
  73     catalyst.pl MyApp
  74     cd MyApp
  75
  76     # add models, views, controllers
  77     script/myapp_create.pl model Something
  78     script/myapp_create.pl view Stuff
  79     script/myapp_create.pl controller Yada
  80
  81     # built in testserver
  82     script/myapp_server.pl
  83
  84     # command line interface
  85     script/myapp_test.pl /yada
  86
  87
  88     use Catalyst;
  89
  90     use Catalyst qw/My::Module My::OtherModule/;
  91
  92     use Catalyst '-Debug';
  93
  94     use Catalyst qw/-Debug -Engine=CGI/;
  95
  96     sub default : Private { $_[1]->res->output('Hello') } );
  97
  98     sub index : Path('/index.html') {
  99         my ( $self, $c ) = @_;
 100         $c->res->output('Hello');
 101         $c->forward('foo');
 102     }
 103
 104     sub product : Regex('^product[_]*(\d*).html$') {
 105         my ( $self, $c ) = @_;
 106         $c->stash->{template} = 'product.tt';
 107         $c->stash->{product} = $c->req->snippets->[0];
 108     }
 109
 110 See also L<Catalyst::Manual::Intro>
 111
 112 =head1 DESCRIPTION
 113
 114 The key concept of Catalyst is DRY (Don't Repeat Yourself).
 115
 116 See L<Catalyst::Manual> for more documentation.
 117
 118 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
 119 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
 120 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
 121
 122     use Catalyst 'My::Module';
 123
 124 Special flags like -Debug and -Engine can also be specified as arguments when
 125 Catalyst is loaded:
 126
 127     use Catalyst qw/-Debug My::Module/;
 128
 129 The position of plugins and flags in the chain is important, because they are
 130 loaded in exactly the order that they appear.
 131
 132 The following flags are supported:
 133
 134 =over 4
 135
 136 =item -Debug
 137
 138 enables debug output, i.e.:
 139
 140     use Catalyst '-Debug';
 141
 142 this is equivalent to:
 143
 144     use Catalyst;
 145     sub debug { 1 }
 146
 147 =item -Dispatcher
 148
 149 Force Catalyst to use a specific dispatcher.
 150
 151 =item -Engine
 152
 153 Force Catalyst to use a specific engine.
 154 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
 155
 156     use Catalyst '-Engine=CGI';
 157
 158 =item -Home
 159
 160 Force Catalyst to use a specific home directory.
 161
 162 =item -Log
 163
 164 Specify log level.
 165
 166 =back
 167
 168 =head1 METHODS
 169
 170 =over 4
 171
 172 =item $c->action
 173
 174 Accessor for the current action
 175
 176 =item $c->comp($name)
 177
 178 =item $c->component($name)
 179
 180 Get a component object by name.
 181
 182     $c->comp('MyApp::Model::MyModel')->do_stuff;
 183
 184 =cut
 185
 186 sub component {
 187     my $c = shift;
 188
 189     if (@_) {
 190
 191         my $name = shift;
 192
 193         my $appclass = ref $c || $c;
 194
 195         my @names = (
 196             $name, "${appclass}::${name}",
 197             map { "${appclass}::${_}::${name}" } qw/M V C/
 198         );
 199
 200         foreach my $try (@names) {
 201
 202             if ( exists $c->components->{$try} ) {
 203
 204                 return $c->components->{$try};
 205             }
 206         }
 207
 208         foreach my $component ( keys %{ $c->components } ) {
 209
 210             return $c->components->{$component} if $component =~ /$name/i;
 211         }
 212
 213     }
 214
 215     return sort keys %{ $c->components };
 216 }
 217
 218 =item config
 219
 220 Returns a hashref containing your applications settings.
 221
 222 =item debug
 223
 224 Overload to enable debug messages.
 225
 226 =cut
 227
 228 sub debug { 0 }
 229
 230 =item $c->detach( $command [, \@arguments ] )
 231
 232 Like C<forward> but doesn't return.
 233
 234 =cut
 235
 236 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 237
 238 =item $c->dispatcher
 239
 240 Contains the dispatcher instance.
 241 Stringifies to class.
 242
 243 =item $c->forward( $command [, \@arguments ] )
 244
 245 Forward processing to a private action or a method from a class.
 246 If you define a class without method it will default to process().
 247 also takes an optional arrayref containing arguments to be passed
 248 to the new function. $c->req->args will be reset upon returning
 249 from the function.
 250
 251     $c->forward('/foo');
 252     $c->forward('index');
 253     $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
 254     $c->forward('MyApp::View::TT');
 255
 256 =cut
 257
 258 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 259
 260 =item $c->namespace
 261
 262 Accessor to the namespace of the current action
 263
 264 =item $c->path_to(@path)
 265
 266 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
 267
 268 For example:
 269
 270     $c->path_to( 'db', 'sqlite.db' );
 271
 272 =cut
 273
 274 sub path_to {
 275     my ( $c, @path ) = @_;
 276     my $path = dir( $c->config->{home}, @path );
 277     if ( -d $path ) { return $path }
 278     else { return file( $c->config->{home}, @path ) }
 279 }
 280
 281 =item $c->setup
 282
 283 Setup.
 284
 285     $c->setup;
 286
 287 =cut
 288
 289 sub setup {
 290     my ( $class, @arguments ) = @_;
 291
 292     unless ( $class->isa('Catalyst') ) {
 293
 294         Catalyst::Exception->throw(
 295             message => qq/'$class' does not inherit from Catalyst/ );
 296     }
 297
 298     if ( $class->arguments ) {
 299         @arguments = ( @arguments, @{ $class->arguments } );
 300     }
 301
 302     # Process options
 303     my $flags = {};
 304
 305     foreach (@arguments) {
 306
 307         if (/^-Debug$/) {
 308             $flags->{log} =
 309               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 310         }
 311         elsif (/^-(\w+)=?(.*)$/) {
 312             $flags->{ lc $1 } = $2;
 313         }
 314         else {
 315             push @{ $flags->{plugins} }, $_;
 316         }
 317     }
 318
 319     $class->setup_log( delete $flags->{log} );
 320     $class->setup_plugins( delete $flags->{plugins} );
 321     $class->setup_dispatcher( delete $flags->{dispatcher} );
 322     $class->setup_engine( delete $flags->{engine} );
 323     $class->setup_home( delete $flags->{home} );
 324
 325     for my $flag ( sort keys %{$flags} ) {
 326
 327         if ( my $code = $class->can( 'setup_' . $flag ) ) {
 328             &$code( $class, delete $flags->{$flag} );
 329         }
 330         else {
 331             $class->log->warn(qq/Unknown flag "$flag"/);
 332         }
 333     }
 334
 335     $class->log->warn( "You are running an old helper script! "
 336           . "Please update your scripts by regenerating the "
 337           . "application and copying over the new scripts." )
 338       if ( $ENV{CATALYST_SCRIPT_GEN}
 339         && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
 340
 341     if ( $class->debug ) {
 342
 343         my @plugins = ();
 344
 345         {
 346             no strict 'refs';
 347             @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
 348         }
 349
 350         if (@plugins) {
 351             my $t = Text::ASCIITable->new;
 352             $t->setOptions( 'hide_HeadRow',  1 );
 353             $t->setOptions( 'hide_HeadLine', 1 );
 354             $t->setCols('Class');
 355             $t->setColWidth( 'Class', 75, 1 );
 356             $t->addRow($_) for @plugins;
 357             $class->log->debug( "Loaded plugins:\n" . $t->draw );
 358         }
 359
 360         my $dispatcher = $class->dispatcher;
 361         my $engine     = $class->engine;
 362         my $home       = $class->config->{home};
 363
 364         $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 365         $class->log->debug(qq/Loaded engine "$engine"/);
 366
 367         $home
 368           ? ( -d $home )
 369           ? $class->log->debug(qq/Found home "$home"/)
 370           : $class->log->debug(qq/Home "$home" doesn't exist/)
 371           : $class->log->debug(q/Couldn't find home/);
 372     }
 373
 374     # Call plugins setup
 375     {
 376         no warnings qw/redefine/;
 377         local *setup = sub { };
 378         $class->setup;
 379     }
 380
 381     # Initialize our data structure
 382     $class->components( {} );
 383
 384     $class->setup_components;
 385
 386     if ( $class->debug ) {
 387         my $t = Text::ASCIITable->new;
 388         $t->setOptions( 'hide_HeadRow',  1 );
 389         $t->setOptions( 'hide_HeadLine', 1 );
 390         $t->setCols('Class');
 391         $t->setColWidth( 'Class', 75, 1 );
 392         $t->addRow($_) for sort keys %{ $class->components };
 393         $class->log->debug( "Loaded components:\n" . $t->draw )
 394           if ( @{ $t->{tbl_rows} } );
 395     }
 396
 397     # Add our self to components, since we are also a component
 398     $class->components->{$class} = $class;
 399
 400     $class->setup_actions;
 401
 402     if ( $class->debug ) {
 403         my $name = $class->config->{name} || 'Application';
 404         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 405     }
 406     $class->log->_flush() if $class->log->can('_flush');
 407 }
 408
 409 =item $c->uri_for($path,[@args])
 410
 411 Merges path with $c->request->base for absolute uri's and with
 412 $c->request->match for relative uri's, then returns a normalized
 413 L<URI> object. If any args are passed, they are added at the end
 414 of the path.
 415
 416 =cut
 417
 418 sub uri_for {
 419     my ( $c, $path, @args ) = @_;
 420     my $base     = $c->request->base->clone;
 421     my $basepath = $base->path;
 422     $basepath =~ s/\/$//;
 423     $basepath .= '/';
 424     my $match = $c->request->match;
 425
 426     # massage match, empty if absolute path
 427     $match =~ s/^\///;
 428     $match .= '/' if $match;
 429     $match = '' if $path =~ /^\//;
 430     $path =~ s/^\///;
 431
 432     # join args with '/', or a blank string
 433     my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
 434     return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
 435         $base )->canonical;
 436 }
 437
 438 =item $c->error
 439
 440 =item $c->error($error, ...)
 441
 442 =item $c->error($arrayref)
 443
 444 Returns an arrayref containing error messages.
 445
 446     my @error = @{ $c->error };
 447
 448 Add a new error.
 449
 450     $c->error('Something bad happened');
 451
 452 Clean errors.
 453
 454     $c->error(0);
 455
 456 =cut
 457
 458 sub error {
 459     my $c = shift;
 460     if ( $_[0] ) {
 461         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 462         push @{ $c->{error} }, @$error;
 463     }
 464     elsif ( defined $_[0] ) { $c->{error} = undef }
 465     return $c->{error} || [];
 466 }
 467
 468 =item $c->engine
 469
 470 Contains the engine instance.
 471 Stringifies to the class.
 472
 473 =item $c->log
 474
 475 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 476 C<Catalyst::Log> object.  To use your own log class:
 477
 478     $c->log( MyLogger->new );
 479     $c->log->info("now logging with my own logger!");
 480
 481 Your log class should implement the methods described in the C<Catalyst::Log>
 482 man page.
 483
 484 =item $c->plugin( $name, $class, @args )
 485
 486 Instant plugins for Catalyst.
 487 Classdata accessor/mutator will be created, class loaded and instantiated.
 488
 489     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 490
 491     $c->prototype->define_javascript_functions;
 492
 493 =cut
 494
 495 sub plugin {
 496     my ( $class, $name, $plugin, @args ) = @_;
 497     $plugin->require;
 498
 499     if ( my $error = $UNIVERSAL::require::ERROR ) {
 500         Catalyst::Exception->throw(
 501             message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
 502     }
 503
 504     eval { $plugin->import };
 505     $class->mk_classdata($name);
 506     my $obj;
 507     eval { $obj = $plugin->new(@args) };
 508
 509     if ($@) {
 510         Catalyst::Exception->throw( message =>
 511               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 512     }
 513
 514     $class->$name($obj);
 515     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 516       if $class->debug;
 517 }
 518
 519 =item $c->request
 520
 521 =item $c->req
 522
 523 Returns a C<Catalyst::Request> object.
 524
 525     my $req = $c->req;
 526
 527 =item $c->response
 528
 529 =item $c->res
 530
 531 Returns a C<Catalyst::Response> object.
 532
 533     my $res = $c->res;
 534
 535 =item $c->state
 536
 537 Contains the return value of the last executed action.
 538
 539 =item $c->stash
 540
 541 Returns a hashref containing all your data.
 542
 543     print $c->stash->{foo};
 544
 545 Keys may be set in the stash by assigning to the hash reference, or by passing
 546 either a single hash reference or a list of key/value pairs as arguments.
 547
 548 For example:
 549
 550     $c->stash->{foo} ||= 'yada';
 551     $c->stash( { moose => 'majestic', qux => 0 } );
 552     $c->stash( bar => 1, gorch => 2 );
 553
 554 =cut
 555
 556 sub stash {
 557     my $c = shift;
 558     if (@_) {
 559         my $stash = @_ > 1 ? {@_} : $_[0];
 560         while ( my ( $key, $val ) = each %$stash ) {
 561             $c->{stash}->{$key} = $val;
 562         }
 563     }
 564     return $c->{stash};
 565 }
 566
 567 =item $c->welcome_message
 568
 569 Returns the Catalyst welcome HTML page.
 570
 571 =cut
 572
 573 sub welcome_message {
 574     my $c      = shift;
 575     my $name   = $c->config->{name};
 576     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
 577     my $prefix = Catalyst::Utils::appprefix( ref $c );
 578     return <<"EOF";
 579 <html>
 580     <head>
 581         <title>$name on Catalyst $VERSION</title>
 582         <style type="text/css">
 583             body {
 584                 text-align: center;
 585                 padding-left: 50%;
 586                 color: #000;
 587                 background-color: #eee;
 588             }
 589             div#content {
 590                 width: 640px;
 591                 margin-left: -320px;
 592                 margin-top: 10px;
 593                 margin-bottom: 10px;
 594                 text-align: left;
 595                 background-color: #ccc;
 596                 border: 1px solid #aaa;
 597                 -moz-border-radius: 10px;
 598             }
 599             p, h1, h2 {
 600                 margin-left: 20px;
 601                 margin-right: 20px;
 602                 font-family: verdana, tahoma, sans-serif;
 603             }
 604             a {
 605                 font-family: verdana, tahoma, sans-serif;
 606             }
 607             :link, :visited {
 608                     text-decoration: none;
 609                     color: #b00;
 610                     border-bottom: 1px dotted #bbb;
 611             }
 612             :link:hover, :visited:hover {
 613                     color: #555;
 614             }
 615             div#topbar {
 616                 margin: 0px;
 617             }
 618             pre {
 619                 margin: 10px;
 620                 padding: 8px;
 621             }
 622             div#answers {
 623                 padding: 8px;
 624                 margin: 10px;
 625                 background-color: #fff;
 626                 border: 1px solid #aaa;
 627                 -moz-border-radius: 10px;
 628             }
 629             h1 {
 630                 font-size: 0.9em;
 631                 font-weight: normal;
 632                 text-align: center;
 633             }
 634             h2 {
 635                 font-size: 1.0em;
 636             }
 637             p {
 638                 font-size: 0.9em;
 639             }
 640             p img {
 641                 float: right;
 642                 margin-left: 10px;
 643             }
 644             b#appname {
 645                 font-size: 1.6em;
 646             }
 647         </style>
 648     </head>
 649     <body>
 650         <div id="content">
 651             <div id="topbar">
 652                 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
 653                     $VERSION</h1>
 654              </div>
 655              <div id="answers">
 656                  <p>
 657                  <img src="$logo"/>
 658                  </p>
 659                  <p>Welcome to the wonderful world of Catalyst.
 660                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
 661                     framework will make web development something you had
 662                     never expected it to be: Fun, rewarding and quick.</p>
 663                  <h2>What to do now?</h2>
 664                  <p>That really depends  on what <b>you</b> want to do.
 665                     We do, however, provide you with a few starting points.</p>
 666                  <p>If you want to jump right into web development with Catalyst
 667                     you might want to check out the documentation.</p>
 668                  <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
 669 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
 670                  <h2>What to do next?</h2>
 671                  <p>Next it's time to write an actual application. Use the
 672                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
 673                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
 674                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
 675                     they can save you a lot of work.</p>
 676                     <pre><code>script/${prefix}_create.pl -help</code></pre>
 677                     <p>Also, be sure to check out the vast and growing
 678                     collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
 679                     you are likely to find what you need there.
 680                     </p>
 681
 682                  <h2>Need help?</h2>
 683                  <p>Catalyst has a very active community. Here are the main places to
 684                     get in touch with us.</p>
 685                  <ul>
 686                      <li>
 687                          <a href="http://dev.catalyst.perl.org">Wiki</a>
 688                      </li>
 689                      <li>
 690                          <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
 691                      </li>
 692                      <li>
 693                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
 694                      </li>
 695                  </ul>
 696                  <h2>In conclusion</h2>
 697                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
 698                     as we enjoyed making it. Please contact us if you have ideas
 699                     for improvement or other feedback.</p>
 700              </div>
 701          </div>
 702     </body>
 703 </html>
 704 EOF
 705 }
 706
 707 =back
 708
 709 =head1 INTERNAL METHODS
 710
 711 =over 4
 712
 713 =item $c->benchmark($coderef)
 714
 715 Takes a coderef with arguments and returns elapsed time as float.
 716
 717     my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
 718     $c->log->info( sprintf "Processing took %f seconds", $elapsed );
 719
 720 =cut
 721
 722 sub benchmark {
 723     my $c       = shift;
 724     my $code    = shift;
 725     my $time    = [gettimeofday];
 726     my @return  = &$code(@_);
 727     my $elapsed = tv_interval $time;
 728     return wantarray ? ( $elapsed, @return ) : $elapsed;
 729 }
 730
 731 =item $c->components
 732
 733 Contains the components.
 734
 735 =item $c->counter
 736
 737 Returns a hashref containing coderefs and execution counts.
 738 (Needed for deep recursion detection)
 739
 740 =item $c->depth
 741
 742 Returns the actual forward depth.
 743
 744 =item $c->dispatch
 745
 746 Dispatch request to actions.
 747
 748 =cut
 749
 750 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
 751
 752 =item $c->execute($class, $coderef)
 753
 754 Execute a coderef in given class and catch exceptions.
 755 Errors are available via $c->error.
 756
 757 =cut
 758
 759 sub execute {
 760     my ( $c, $class, $code ) = @_;
 761     $class = $c->components->{$class} || $class;
 762     $c->state(0);
 763     my $callsub = ( caller(1) )[3];
 764
 765     my $action = '';
 766     if ( $c->debug ) {
 767         $action = "$code";
 768         $action = "/$action" unless $action =~ /\-\>/;
 769         $c->counter->{"$code"}++;
 770
 771         if ( $c->counter->{"$code"} > $RECURSION ) {
 772             my $error = qq/Deep recursion detected in "$action"/;
 773             $c->log->error($error);
 774             $c->error($error);
 775             $c->state(0);
 776             return $c->state;
 777         }
 778
 779         $action = "-> $action" if $callsub =~ /forward$/;
 780     }
 781     $c->{depth}++;
 782     eval {
 783         if ( $c->debug )
 784         {
 785             my ( $elapsed, @state ) =
 786               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
 787             push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
 788             $c->state(@state);
 789         }
 790         else {
 791             $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
 792         }
 793     };
 794     $c->{depth}--;
 795
 796     if ( my $error = $@ ) {
 797
 798         if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
 799         else {
 800             unless ( ref $error ) {
 801                 chomp $error;
 802                 $error = qq/Caught exception "$error"/;
 803             }
 804
 805             $c->log->error($error);
 806             $c->error($error);
 807             $c->state(0);
 808         }
 809     }
 810     return $c->state;
 811 }
 812
 813 =item $c->finalize
 814
 815 Finalize request.
 816
 817 =cut
 818
 819 sub finalize {
 820     my $c = shift;
 821
 822     $c->finalize_uploads;
 823
 824     # Error
 825     if ( $#{ $c->error } >= 0 ) {
 826         $c->finalize_error;
 827     }
 828
 829     $c->finalize_headers;
 830
 831     # HEAD request
 832     if ( $c->request->method eq 'HEAD' ) {
 833         $c->response->body('');
 834     }
 835
 836     $c->finalize_body;
 837
 838     return $c->response->status;
 839 }
 840
 841 =item $c->finalize_body
 842
 843 Finalize body.
 844
 845 =cut
 846
 847 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
 848
 849 =item $c->finalize_cookies
 850
 851 Finalize cookies.
 852
 853 =cut
 854
 855 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
 856
 857 =item $c->finalize_error
 858
 859 Finalize error.
 860
 861 =cut
 862
 863 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
 864
 865 =item $c->finalize_headers
 866
 867 Finalize headers.
 868
 869 =cut
 870
 871 sub finalize_headers {
 872     my $c = shift;
 873
 874     # Check if we already finalized headers
 875     return if $c->response->{_finalized_headers};
 876
 877     # Handle redirects
 878     if ( my $location = $c->response->redirect ) {
 879         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
 880         $c->response->header( Location => $location );
 881     }
 882
 883     # Content-Length
 884     if ( $c->response->body && !$c->response->content_length ) {
 885         $c->response->content_length( bytes::length( $c->response->body ) );
 886     }
 887
 888     # Errors
 889     if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
 890         $c->response->headers->remove_header("Content-Length");
 891         $c->response->body('');
 892     }
 893
 894     $c->finalize_cookies;
 895
 896     $c->engine->finalize_headers( $c, @_ );
 897
 898     # Done
 899     $c->response->{_finalized_headers} = 1;
 900 }
 901
 902 =item $c->finalize_output
 903
 904 An alias for finalize_body.
 905
 906 =item $c->finalize_read
 907
 908 Finalize the input after reading is complete.
 909
 910 =cut
 911
 912 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
 913
 914 =item $c->finalize_uploads
 915
 916 Finalize uploads.  Cleans up any temporary files.
 917
 918 =cut
 919
 920 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
 921
 922 =item $c->get_action( $action, $namespace )
 923
 924 Get an action in a given namespace.
 925
 926 =cut
 927
 928 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
 929
 930 =item $c->get_actions( $action, $namespace )
 931
 932 Get all actions of a given name in a namespace and all base namespaces.
 933
 934 =cut
 935
 936 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
 937
 938 =item handle_request( $class, @arguments )
 939
 940 Handles the request.
 941
 942 =cut
 943
 944 sub handle_request {
 945     my ( $class, @arguments ) = @_;
 946
 947     # Always expect worst case!
 948     my $status = -1;
 949     eval {
 950         my @stats = ();
 951
 952         my $handler = sub {
 953             my $c = $class->prepare(@arguments);
 954             $c->{stats} = \@stats;
 955             $c->dispatch;
 956             return $c->finalize;
 957         };
 958
 959         if ( $class->debug ) {
 960             my $elapsed;
 961             ( $elapsed, $status ) = $class->benchmark($handler);
 962             $elapsed = sprintf '%f', $elapsed;
 963             my $av = sprintf '%.3f',
 964               ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
 965             my $t = Text::ASCIITable->new;
 966             $t->setCols( 'Action', 'Time' );
 967             $t->setColWidth( 'Action', 64, 1 );
 968             $t->setColWidth( 'Time',   9,  1 );
 969
 970             for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
 971             $class->log->info(
 972                 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
 973         }
 974         else { $status = &$handler }
 975
 976     };
 977
 978     if ( my $error = $@ ) {
 979         chomp $error;
 980         $class->log->error(qq/Caught exception in engine "$error"/);
 981     }
 982
 983     $COUNT++;
 984     $class->log->_flush() if $class->log->can('_flush');
 985     return $status;
 986 }
 987
 988 =item $c->prepare(@arguments)
 989
 990 Turns the engine-specific request( Apache, CGI ... )
 991 into a Catalyst context .
 992
 993 =cut
 994
 995 sub prepare {
 996     my ( $class, @arguments ) = @_;
 997
 998     my $c = bless {
 999         counter => {},
1000         depth   => 0,
1001         request => Catalyst::Request->new(
1002             {
1003                 arguments        => [],
1004                 body_parameters  => {},
1005                 cookies          => {},
1006                 headers          => HTTP::Headers->new,
1007                 parameters       => {},
1008                 query_parameters => {},
1009                 secure           => 0,
1010                 snippets         => [],
1011                 uploads          => {}
1012             }
1013         ),
1014         response => Catalyst::Response->new(
1015             {
1016                 body    => '',
1017                 cookies => {},
1018                 headers => HTTP::Headers->new(),
1019                 status  => 200
1020             }
1021         ),
1022         stash => {},
1023         state => 0
1024     }, $class;
1025
1026     # For on-demand data
1027     $c->request->{_context}  = $c;
1028     $c->response->{_context} = $c;
1029     weaken( $c->request->{_context} );
1030     weaken( $c->response->{_context} );
1031
1032     if ( $c->debug ) {
1033         my $secs = time - $START || 1;
1034         my $av = sprintf '%.3f', $COUNT / $secs;
1035         $c->log->debug('**********************************');
1036         $c->log->debug("* Request $COUNT ($av/s) [$$]");
1037         $c->log->debug('**********************************');
1038         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1039     }
1040
1041     $c->prepare_request(@arguments);
1042     $c->prepare_connection;
1043     $c->prepare_query_parameters;
1044     $c->prepare_headers;
1045     $c->prepare_cookies;
1046     $c->prepare_path;
1047
1048     # On-demand parsing
1049     $c->prepare_body unless $c->config->{parse_on_demand};
1050
1051     $c->prepare_action;
1052     my $method  = $c->req->method  || '';
1053     my $path    = $c->req->path    || '';
1054     my $address = $c->req->address || '';
1055
1056     $c->log->debug(qq/"$method" request for "$path" from $address/)
1057       if $c->debug;
1058
1059     return $c;
1060 }
1061
1062 =item $c->prepare_action
1063
1064 Prepare action.
1065
1066 =cut
1067
1068 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1069
1070 =item $c->prepare_body
1071
1072 Prepare message body.
1073
1074 =cut
1075
1076 sub prepare_body {
1077     my $c = shift;
1078
1079     # Do we run for the first time?
1080     return if defined $c->request->{_body};
1081
1082     # Initialize on-demand data
1083     $c->engine->prepare_body( $c, @_ );
1084     $c->prepare_parameters;
1085     $c->prepare_uploads;
1086
1087     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1088         my $t = Text::ASCIITable->new;
1089         $t->setCols( 'Key', 'Value' );
1090         $t->setColWidth( 'Key',   37, 1 );
1091         $t->setColWidth( 'Value', 36, 1 );
1092         $t->alignCol( 'Value', 'right' );
1093         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1094             my $param = $c->req->body_parameters->{$key};
1095             my $value = defined($param) ? $param : '';
1096             $t->addRow( $key,
1097                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1098         }
1099         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1100     }
1101 }
1102
1103 =item $c->prepare_body_chunk( $chunk )
1104
1105 Prepare a chunk of data before sending it to HTTP::Body.
1106
1107 =cut
1108
1109 sub prepare_body_chunk {
1110     my $c = shift;
1111     $c->engine->prepare_body_chunk( $c, @_ );
1112 }
1113
1114 =item $c->prepare_body_parameters
1115
1116 Prepare body parameters.
1117
1118 =cut
1119
1120 sub prepare_body_parameters {
1121     my $c = shift;
1122     $c->engine->prepare_body_parameters( $c, @_ );
1123 }
1124
1125 =item $c->prepare_connection
1126
1127 Prepare connection.
1128
1129 =cut
1130
1131 sub prepare_connection {
1132     my $c = shift;
1133     $c->engine->prepare_connection( $c, @_ );
1134 }
1135
1136 =item $c->prepare_cookies
1137
1138 Prepare cookies.
1139
1140 =cut
1141
1142 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1143
1144 =item $c->prepare_headers
1145
1146 Prepare headers.
1147
1148 =cut
1149
1150 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1151
1152 =item $c->prepare_parameters
1153
1154 Prepare parameters.
1155
1156 =cut
1157
1158 sub prepare_parameters {
1159     my $c = shift;
1160     $c->prepare_body_parameters;
1161     $c->engine->prepare_parameters( $c, @_ );
1162 }
1163
1164 =item $c->prepare_path
1165
1166 Prepare path and base.
1167
1168 =cut
1169
1170 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1171
1172 =item $c->prepare_query_parameters
1173
1174 Prepare query parameters.
1175
1176 =cut
1177
1178 sub prepare_query_parameters {
1179     my $c = shift;
1180
1181     $c->engine->prepare_query_parameters( $c, @_ );
1182
1183     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1184         my $t = Text::ASCIITable->new;
1185         $t->setCols( 'Key', 'Value' );
1186         $t->setColWidth( 'Key',   37, 1 );
1187         $t->setColWidth( 'Value', 36, 1 );
1188         $t->alignCol( 'Value', 'right' );
1189         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1190             my $param = $c->req->query_parameters->{$key};
1191             my $value = defined($param) ? $param : '';
1192             $t->addRow( $key,
1193                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1194         }
1195         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1196     }
1197 }
1198
1199 =item $c->prepare_read
1200
1201 Prepare the input for reading.
1202
1203 =cut
1204
1205 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1206
1207 =item $c->prepare_request
1208
1209 Prepare the engine request.
1210
1211 =cut
1212
1213 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1214
1215 =item $c->prepare_uploads
1216
1217 Prepare uploads.
1218
1219 =cut
1220
1221 sub prepare_uploads {
1222     my $c = shift;
1223
1224     $c->engine->prepare_uploads( $c, @_ );
1225
1226     if ( $c->debug && keys %{ $c->request->uploads } ) {
1227         my $t = Text::ASCIITable->new;
1228         $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1229         $t->setColWidth( 'Key',      12, 1 );
1230         $t->setColWidth( 'Filename', 28, 1 );
1231         $t->setColWidth( 'Type',     18, 1 );
1232         $t->setColWidth( 'Size',     9,  1 );
1233         $t->alignCol( 'Size', 'left' );
1234         for my $key ( sort keys %{ $c->request->uploads } ) {
1235             my $upload = $c->request->uploads->{$key};
1236             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1237                 $t->addRow( $key, $u->filename, $u->type, $u->size );
1238             }
1239         }
1240         $c->log->debug( "File Uploads are:\n" . $t->draw );
1241     }
1242 }
1243
1244 =item $c->prepare_write
1245
1246 Prepare the output for writing.
1247
1248 =cut
1249
1250 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1251
1252 =item $c->read( [$maxlength] )
1253
1254 Read a chunk of data from the request body.  This method is designed to be
1255 used in a while loop, reading $maxlength bytes on every call.  $maxlength
1256 defaults to the size of the request if not specified.
1257
1258 You have to set MyApp->config->{parse_on_demand} to use this directly.
1259
1260 =cut
1261
1262 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1263
1264 =item $c->run
1265
1266 Starts the engine.
1267
1268 =cut
1269
1270 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1271
1272 =item $c->set_action( $action, $code, $namespace, $attrs )
1273
1274 Set an action in a given namespace.
1275
1276 =cut
1277
1278 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1279
1280 =item $c->setup_actions($component)
1281
1282 Setup actions for a component.
1283
1284 =cut
1285
1286 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1287
1288 =item $c->setup_components
1289
1290 Setup components.
1291
1292 =cut
1293
1294 sub setup_components {
1295     my $class = shift;
1296
1297     my $callback = sub {
1298         my ( $component, $context ) = @_;
1299
1300         unless ( $component->isa('Catalyst::Base') ) {
1301             return $component;
1302         }
1303
1304         my $suffix = Catalyst::Utils::class2classsuffix($component);
1305         my $config = $class->config->{$suffix} || {};
1306
1307         my $instance;
1308
1309         eval { $instance = $component->new( $context, $config ); };
1310
1311         if ( my $error = $@ ) {
1312
1313             chomp $error;
1314
1315             Catalyst::Exception->throw( message =>
1316                   qq/Couldn't instantiate component "$component", "$error"/ );
1317         }
1318
1319         Catalyst::Exception->throw( message =>
1320 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1321           )
1322           unless ref $instance;
1323         return $instance;
1324     };
1325
1326     eval {
1327         Module::Pluggable::Fast->import(
1328             name   => '_catalyst_components',
1329             search => [
1330                 "$class\::Controller", "$class\::C",
1331                 "$class\::Model",      "$class\::M",
1332                 "$class\::View",       "$class\::V"
1333             ],
1334             callback => $callback
1335         );
1336     };
1337
1338     if ( my $error = $@ ) {
1339
1340         chomp $error;
1341
1342         Catalyst::Exception->throw(
1343             message => qq/Couldn't load components "$error"/ );
1344     }
1345
1346     for my $component ( $class->_catalyst_components($class) ) {
1347         $class->components->{ ref $component || $component } = $component;
1348     }
1349 }
1350
1351 =item $c->setup_dispatcher
1352
1353 =cut
1354
1355 sub setup_dispatcher {
1356     my ( $class, $dispatcher ) = @_;
1357
1358     if ($dispatcher) {
1359         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1360     }
1361
1362     if ( $ENV{CATALYST_DISPATCHER} ) {
1363         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1364     }
1365
1366     if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1367         $dispatcher =
1368           'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1369     }
1370
1371     unless ($dispatcher) {
1372         $dispatcher = 'Catalyst::Dispatcher';
1373     }
1374
1375     $dispatcher->require;
1376
1377     if ($@) {
1378         Catalyst::Exception->throw(
1379             message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1380     }
1381
1382     # dispatcher instance
1383     $class->dispatcher( $dispatcher->new );
1384 }
1385
1386 =item $c->setup_engine
1387
1388 =cut
1389
1390 sub setup_engine {
1391     my ( $class, $engine ) = @_;
1392
1393     if ($engine) {
1394         $engine = 'Catalyst::Engine::' . $engine;
1395     }
1396
1397     if ( $ENV{CATALYST_ENGINE} ) {
1398         $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1399     }
1400
1401     if ( $ENV{ uc($class) . '_ENGINE' } ) {
1402         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1403     }
1404
1405     if ( !$engine && $ENV{MOD_PERL} ) {
1406
1407         # create the apache method
1408         {
1409             no strict 'refs';
1410             *{"$class\::apache"} = sub { shift->engine->apache };
1411         }
1412
1413         my ( $software, $version ) =
1414           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1415
1416         $version =~ s/_//g;
1417         $version =~ s/(\.[^.]+)\./$1/g;
1418
1419         if ( $software eq 'mod_perl' ) {
1420
1421             if ( $version >= 1.99922 ) {
1422                 $engine = 'Catalyst::Engine::Apache2::MP20';
1423             }
1424
1425             elsif ( $version >= 1.9901 ) {
1426                 $engine = 'Catalyst::Engine::Apache2::MP19';
1427             }
1428
1429             elsif ( $version >= 1.24 ) {
1430                 $engine = 'Catalyst::Engine::Apache::MP13';
1431             }
1432
1433             else {
1434                 Catalyst::Exception->throw( message =>
1435                       qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1436             }
1437
1438             # install the correct mod_perl handler
1439             if ( $version >= 1.9901 ) {
1440                 *handler = sub  : method {
1441                     shift->handle_request(@_);
1442                 };
1443             }
1444             else {
1445                 *handler = sub ($$) { shift->handle_request(@_) };
1446             }
1447
1448         }
1449
1450         elsif ( $software eq 'Zeus-Perl' ) {
1451             $engine = 'Catalyst::Engine::Zeus';
1452         }
1453
1454         else {
1455             Catalyst::Exception->throw(
1456                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1457         }
1458     }
1459
1460     unless ($engine) {
1461         $engine = 'Catalyst::Engine::CGI';
1462     }
1463
1464     $engine->require;
1465
1466     if ($@) {
1467         Catalyst::Exception->throw( message =>
1468 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1469         );
1470     }
1471
1472     # check for old engines that are no longer compatible
1473     my $old_engine;
1474     if (   $engine->isa('Catalyst::Engine::Apache')
1475         && ! Catalyst::Engine::Apache->VERSION )
1476     {
1477         $old_engine = 1;
1478     }
1479
1480     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1481          && Catalyst::Engine::Server->VERSION le '0.02' )
1482     {
1483         $old_engine = 1;
1484     }
1485
1486     elsif ( $engine->isa('Catalyst::Engine::HTTP::POE')
1487          && $engine->VERSION eq '0.01' )
1488     {
1489         $old_engine = 1;
1490     }
1491
1492     elsif ( $engine->isa('Catalyst::Engine::Zeus')
1493          && $engine->VERSION eq '0.01' )
1494     {
1495         $old_engine = 1;
1496     }
1497
1498     if ($old_engine) {
1499         Catalyst::Exception->throw( message =>
1500             qq/Engine "$engine" is not supported by this version of Catalyst/
1501         );
1502     }
1503
1504     # engine instance
1505     $class->engine( $engine->new );
1506 }
1507
1508 =item $c->setup_home
1509
1510 =cut
1511
1512 sub setup_home {
1513     my ( $class, $home ) = @_;
1514
1515     if ( $ENV{CATALYST_HOME} ) {
1516         $home = $ENV{CATALYST_HOME};
1517     }
1518
1519     if ( $ENV{ uc($class) . '_HOME' } ) {
1520         $home = $ENV{ uc($class) . '_HOME' };
1521     }
1522
1523     unless ($home) {
1524         $home = Catalyst::Utils::home($class);
1525     }
1526
1527     if ($home) {
1528         $class->config->{home} ||= $home;
1529         $class->config->{root} ||= dir($home)->subdir('root');
1530     }
1531 }
1532
1533 =item $c->setup_log
1534
1535 =cut
1536
1537 sub setup_log {
1538     my ( $class, $debug ) = @_;
1539
1540     unless ( $class->log ) {
1541         $class->log( Catalyst::Log->new );
1542     }
1543
1544     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1545         no strict 'refs';
1546         *{"$class\::debug"} = sub { 1 };
1547         $class->log->debug('Debug messages enabled');
1548     }
1549 }
1550
1551 =item $c->setup_plugins
1552
1553 =cut
1554
1555 sub setup_plugins {
1556     my ( $class, $plugins ) = @_;
1557
1558     $plugins ||= [];
1559     for my $plugin ( reverse @$plugins ) {
1560
1561         $plugin = "Catalyst::Plugin::$plugin";
1562
1563         $plugin->require;
1564
1565         if ($@) {
1566             Catalyst::Exception->throw(
1567                 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1568         }
1569
1570         {
1571             no strict 'refs';
1572             unshift @{"$class\::ISA"}, $plugin;
1573         }
1574     }
1575 }
1576
1577 =item $c->write( $data )
1578
1579 Writes $data to the output stream.  When using this method directly, you will
1580 need to manually set the Content-Length header to the length of your output
1581 data, if known.
1582
1583 =cut
1584
1585 sub write {
1586     my $c = shift;
1587
1588     # Finalize headers if someone manually writes output
1589     $c->finalize_headers;
1590
1591     return $c->engine->write( $c, @_ );
1592 }
1593
1594 =item version
1595
1596 Returns the Catalyst version number. mostly useful for powered by messages
1597 in template systems.
1598
1599 =cut
1600
1601 sub version { return $Catalyst::VERSION }
1602
1603 =back
1604
1605 =head1 INTERNAL ACTIONS
1606
1607 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1608 C<_ACTION> and C<_END>, these are by default not shown in the private
1609 action table.
1610
1611 But you can deactivate this with a config parameter.
1612
1613     MyApp->config->{show_internal_actions} = 1;
1614
1615 =head1 CASE SENSITIVITY
1616
1617 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1618 C</foo/bar>.
1619
1620 But you can activate case sensitivity with a config parameter.
1621
1622     MyApp->config->{case_sensitive} = 1;
1623
1624 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1625
1626 =head1 ON-DEMAND PARSER
1627
1628 The request body is usually parsed at the beginning of a request,
1629 but if you want to handle input yourself or speed things up a bit
1630 you can enable on-demand parsing with a config parameter.
1631
1632     MyApp->config->{parse_on_demand} = 1;
1633
1634 =head1 PROXY SUPPORT
1635
1636 Many production servers operate using the common double-server approach, with
1637 a lightweight frontend web server passing requests to a larger backend
1638 server.  An application running on the backend server must deal with two
1639 problems: the remote user always appears to be '127.0.0.1' and the server's
1640 hostname will appear to be 'localhost' regardless of the virtual host the
1641 user connected through.
1642
1643 Catalyst will automatically detect this situation when you are running both
1644 the frontend and backend servers on the same machine.  The following changes
1645 are made to the request.
1646
1647     $c->req->address is set to the user's real IP address, as read from the
1648     HTTP_X_FORWARDED_FOR header.
1649
1650     The host value for $c->req->base and $c->req->uri is set to the real host,
1651     as read from the HTTP_X_FORWARDED_HOST header.
1652
1653 Obviously, your web server must support these 2 headers for this to work.
1654
1655 In a more complex server farm environment where you may have your frontend
1656 proxy server(s) on different machines, you will need to set a configuration
1657 option to tell Catalyst to read the proxied data from the headers.
1658
1659     MyApp->config->{using_frontend_proxy} = 1;
1660
1661 If you do not wish to use the proxy support at all, you may set:
1662
1663     MyApp->config->{ignore_frontend_proxy} = 1;
1664
1665 =head1 THREAD SAFETY
1666
1667 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1668 and the standalone forking HTTP server on Windows.  We believe the Catalyst
1669 core to be thread-safe.
1670
1671 If you plan to operate in a threaded environment, remember that all other
1672 modules you are using must also be thread-safe.  Some modules, most notably
1673 DBD::SQLite, are not thread-safe.
1674
1675 =head1 SUPPORT
1676
1677 IRC:
1678
1679     Join #catalyst on irc.perl.org.
1680
1681 Mailing-Lists:
1682
1683     http://lists.rawmode.org/mailman/listinfo/catalyst
1684     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1685
1686 Web:
1687
1688     http://catalyst.perl.org
1689
1690 =head1 SEE ALSO
1691
1692 =over 4
1693
1694 =item L<Catalyst::Manual> - The Catalyst Manual
1695
1696 =item L<Catalyst::Engine> - Core Engine
1697
1698 =item L<Catalyst::Log> - The Log Class.
1699
1700 =item L<Catalyst::Request> - The Request Object
1701
1702 =item L<Catalyst::Response> - The Response Object
1703
1704 =item L<Catalyst::Test> - The test suite.
1705
1706 =back
1707
1708 =head1 CREDITS
1709
1710 Andy Grundman
1711
1712 Andy Wardley
1713
1714 Andreas Marienborg
1715
1716 Andrew Bramble
1717
1718 Andrew Ford
1719
1720 Andrew Ruthven
1721
1722 Arthur Bergman
1723
1724 Autrijus Tang
1725
1726 Christian Hansen
1727
1728 Christopher Hicks
1729
1730 Dan Sully
1731
1732 Danijel Milicevic
1733
1734 David Naughton
1735
1736 Gary Ashton Jones
1737
1738 Geoff Richards
1739
1740 Jesse Sheidlower
1741
1742 Jesse Vincent
1743
1744 Jody Belka
1745
1746 Johan Lindstrom
1747
1748 Juan Camacho
1749
1750 Leon Brocard
1751
1752 Marcus Ramberg
1753
1754 Matt S Trout
1755
1756 Robert Sedlacek
1757
1758 Sam Vilain
1759
1760 Tatsuhiko Miyagawa
1761
1762 Ulf Edvinsson
1763
1764 Yuval Kogman
1765
1766 =head1 AUTHOR
1767
1768 Sebastian Riedel, C<sri@oook.de>
1769
1770 =head1 LICENSE
1771
1772 This library is free software, you can redistribute it and/or modify it under
1773 the same terms as Perl itself.
1774
1775 =cut
1776
1777 1;