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
 753 =item dump_these
 754
 755 Returns a list of 2-element array references (name, structure) pairs that will
 756 be dumped on the error page in debug mode.
 757
 758 =cut
 759
 760 sub dump_these {
 761     my $c = shift;
 762     [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
 763 }
 764
 765 =item $c->execute($class, $coderef)
 766
 767 Execute a coderef in given class and catch exceptions.
 768 Errors are available via $c->error.
 769
 770 =cut
 771
 772 sub execute {
 773     my ( $c, $class, $code ) = @_;
 774     $class = $c->components->{$class} || $class;
 775     $c->state(0);
 776     my $callsub = ( caller(1) )[3];
 777
 778     my $action = '';
 779     if ( $c->debug ) {
 780         $action = "$code";
 781         $action = "/$action" unless $action =~ /\-\>/;
 782         $c->counter->{"$code"}++;
 783
 784         if ( $c->counter->{"$code"} > $RECURSION ) {
 785             my $error = qq/Deep recursion detected in "$action"/;
 786             $c->log->error($error);
 787             $c->error($error);
 788             $c->state(0);
 789             return $c->state;
 790         }
 791
 792         $action = "-> $action" if $callsub =~ /forward$/;
 793     }
 794     $c->{depth}++;
 795     eval {
 796         if ( $c->debug )
 797         {
 798             my ( $elapsed, @state ) =
 799               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
 800             push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
 801             $c->state(@state);
 802         }
 803         else {
 804             $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
 805         }
 806     };
 807     $c->{depth}--;
 808
 809     if ( my $error = $@ ) {
 810
 811         if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
 812         else {
 813             unless ( ref $error ) {
 814                 chomp $error;
 815                 $error = qq/Caught exception "$error"/;
 816             }
 817
 818             $c->log->error($error);
 819             $c->error($error);
 820             $c->state(0);
 821         }
 822     }
 823     return $c->state;
 824 }
 825
 826 =item $c->finalize
 827
 828 Finalize request.
 829
 830 =cut
 831
 832 sub finalize {
 833     my $c = shift;
 834
 835     $c->finalize_uploads;
 836
 837     # Error
 838     if ( $#{ $c->error } >= 0 ) {
 839         $c->finalize_error;
 840     }
 841
 842     $c->finalize_headers;
 843
 844     # HEAD request
 845     if ( $c->request->method eq 'HEAD' ) {
 846         $c->response->body('');
 847     }
 848
 849     $c->finalize_body;
 850
 851     return $c->response->status;
 852 }
 853
 854 =item $c->finalize_body
 855
 856 Finalize body.
 857
 858 =cut
 859
 860 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
 861
 862 =item $c->finalize_cookies
 863
 864 Finalize cookies.
 865
 866 =cut
 867
 868 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
 869
 870 =item $c->finalize_error
 871
 872 Finalize error.
 873
 874 =cut
 875
 876 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
 877
 878 =item $c->finalize_headers
 879
 880 Finalize headers.
 881
 882 =cut
 883
 884 sub finalize_headers {
 885     my $c = shift;
 886
 887     # Check if we already finalized headers
 888     return if $c->response->{_finalized_headers};
 889
 890     # Handle redirects
 891     if ( my $location = $c->response->redirect ) {
 892         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
 893         $c->response->header( Location => $location );
 894     }
 895
 896     # Content-Length
 897     if ( $c->response->body && !$c->response->content_length ) {
 898         $c->response->content_length( bytes::length( $c->response->body ) );
 899     }
 900
 901     # Errors
 902     if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
 903         $c->response->headers->remove_header("Content-Length");
 904         $c->response->body('');
 905     }
 906
 907     $c->finalize_cookies;
 908
 909     $c->engine->finalize_headers( $c, @_ );
 910
 911     # Done
 912     $c->response->{_finalized_headers} = 1;
 913 }
 914
 915 =item $c->finalize_output
 916
 917 An alias for finalize_body.
 918
 919 =item $c->finalize_read
 920
 921 Finalize the input after reading is complete.
 922
 923 =cut
 924
 925 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
 926
 927 =item $c->finalize_uploads
 928
 929 Finalize uploads.  Cleans up any temporary files.
 930
 931 =cut
 932
 933 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
 934
 935 =item $c->get_action( $action, $namespace )
 936
 937 Get an action in a given namespace.
 938
 939 =cut
 940
 941 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
 942
 943 =item $c->get_actions( $action, $namespace )
 944
 945 Get all actions of a given name in a namespace and all base namespaces.
 946
 947 =cut
 948
 949 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
 950
 951 =item handle_request( $class, @arguments )
 952
 953 Handles the request.
 954
 955 =cut
 956
 957 sub handle_request {
 958     my ( $class, @arguments ) = @_;
 959
 960     # Always expect worst case!
 961     my $status = -1;
 962     eval {
 963         my @stats = ();
 964
 965         my $handler = sub {
 966             my $c = $class->prepare(@arguments);
 967             $c->{stats} = \@stats;
 968             $c->dispatch;
 969             return $c->finalize;
 970         };
 971
 972         if ( $class->debug ) {
 973             my $elapsed;
 974             ( $elapsed, $status ) = $class->benchmark($handler);
 975             $elapsed = sprintf '%f', $elapsed;
 976             my $av = sprintf '%.3f',
 977               ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
 978             my $t = Text::ASCIITable->new;
 979             $t->setCols( 'Action', 'Time' );
 980             $t->setColWidth( 'Action', 64, 1 );
 981             $t->setColWidth( 'Time',   9,  1 );
 982
 983             for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
 984             $class->log->info(
 985                 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
 986         }
 987         else { $status = &$handler }
 988
 989     };
 990
 991     if ( my $error = $@ ) {
 992         chomp $error;
 993         $class->log->error(qq/Caught exception in engine "$error"/);
 994     }
 995
 996     $COUNT++;
 997     $class->log->_flush() if $class->log->can('_flush');
 998     return $status;
 999 }
1000
1001 =item $c->prepare(@arguments)
1002
1003 Turns the engine-specific request( Apache, CGI ... )
1004 into a Catalyst context .
1005
1006 =cut
1007
1008 sub prepare {
1009     my ( $class, @arguments ) = @_;
1010
1011     my $c = bless {
1012         counter => {},
1013         depth   => 0,
1014         request => Catalyst::Request->new(
1015             {
1016                 arguments        => [],
1017                 body_parameters  => {},
1018                 cookies          => {},
1019                 headers          => HTTP::Headers->new,
1020                 parameters       => {},
1021                 query_parameters => {},
1022                 secure           => 0,
1023                 snippets         => [],
1024                 uploads          => {}
1025             }
1026         ),
1027         response => Catalyst::Response->new(
1028             {
1029                 body    => '',
1030                 cookies => {},
1031                 headers => HTTP::Headers->new(),
1032                 status  => 200
1033             }
1034         ),
1035         stash => {},
1036         state => 0
1037     }, $class;
1038
1039     # For on-demand data
1040     $c->request->{_context}  = $c;
1041     $c->response->{_context} = $c;
1042     weaken( $c->request->{_context} );
1043     weaken( $c->response->{_context} );
1044
1045     if ( $c->debug ) {
1046         my $secs = time - $START || 1;
1047         my $av = sprintf '%.3f', $COUNT / $secs;
1048         $c->log->debug('**********************************');
1049         $c->log->debug("* Request $COUNT ($av/s) [$$]");
1050         $c->log->debug('**********************************');
1051         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1052     }
1053
1054     $c->prepare_request(@arguments);
1055     $c->prepare_connection;
1056     $c->prepare_query_parameters;
1057     $c->prepare_headers;
1058     $c->prepare_cookies;
1059     $c->prepare_path;
1060
1061     # On-demand parsing
1062     $c->prepare_body unless $c->config->{parse_on_demand};
1063
1064     $c->prepare_action;
1065     my $method  = $c->req->method  || '';
1066     my $path    = $c->req->path    || '';
1067     my $address = $c->req->address || '';
1068
1069     $c->log->debug(qq/"$method" request for "$path" from $address/)
1070       if $c->debug;
1071
1072     return $c;
1073 }
1074
1075 =item $c->prepare_action
1076
1077 Prepare action.
1078
1079 =cut
1080
1081 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1082
1083 =item $c->prepare_body
1084
1085 Prepare message body.
1086
1087 =cut
1088
1089 sub prepare_body {
1090     my $c = shift;
1091
1092     # Do we run for the first time?
1093     return if defined $c->request->{_body};
1094
1095     # Initialize on-demand data
1096     $c->engine->prepare_body( $c, @_ );
1097     $c->prepare_parameters;
1098     $c->prepare_uploads;
1099
1100     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1101         my $t = Text::ASCIITable->new;
1102         $t->setCols( 'Key', 'Value' );
1103         $t->setColWidth( 'Key',   37, 1 );
1104         $t->setColWidth( 'Value', 36, 1 );
1105         $t->alignCol( 'Value', 'right' );
1106         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1107             my $param = $c->req->body_parameters->{$key};
1108             my $value = defined($param) ? $param : '';
1109             $t->addRow( $key,
1110                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1111         }
1112         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1113     }
1114 }
1115
1116 =item $c->prepare_body_chunk( $chunk )
1117
1118 Prepare a chunk of data before sending it to HTTP::Body.
1119
1120 =cut
1121
1122 sub prepare_body_chunk {
1123     my $c = shift;
1124     $c->engine->prepare_body_chunk( $c, @_ );
1125 }
1126
1127 =item $c->prepare_body_parameters
1128
1129 Prepare body parameters.
1130
1131 =cut
1132
1133 sub prepare_body_parameters {
1134     my $c = shift;
1135     $c->engine->prepare_body_parameters( $c, @_ );
1136 }
1137
1138 =item $c->prepare_connection
1139
1140 Prepare connection.
1141
1142 =cut
1143
1144 sub prepare_connection {
1145     my $c = shift;
1146     $c->engine->prepare_connection( $c, @_ );
1147 }
1148
1149 =item $c->prepare_cookies
1150
1151 Prepare cookies.
1152
1153 =cut
1154
1155 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1156
1157 =item $c->prepare_headers
1158
1159 Prepare headers.
1160
1161 =cut
1162
1163 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1164
1165 =item $c->prepare_parameters
1166
1167 Prepare parameters.
1168
1169 =cut
1170
1171 sub prepare_parameters {
1172     my $c = shift;
1173     $c->prepare_body_parameters;
1174     $c->engine->prepare_parameters( $c, @_ );
1175 }
1176
1177 =item $c->prepare_path
1178
1179 Prepare path and base.
1180
1181 =cut
1182
1183 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1184
1185 =item $c->prepare_query_parameters
1186
1187 Prepare query parameters.
1188
1189 =cut
1190
1191 sub prepare_query_parameters {
1192     my $c = shift;
1193
1194     $c->engine->prepare_query_parameters( $c, @_ );
1195
1196     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1197         my $t = Text::ASCIITable->new;
1198         $t->setCols( 'Key', 'Value' );
1199         $t->setColWidth( 'Key',   37, 1 );
1200         $t->setColWidth( 'Value', 36, 1 );
1201         $t->alignCol( 'Value', 'right' );
1202         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1203             my $param = $c->req->query_parameters->{$key};
1204             my $value = defined($param) ? $param : '';
1205             $t->addRow( $key,
1206                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1207         }
1208         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1209     }
1210 }
1211
1212 =item $c->prepare_read
1213
1214 Prepare the input for reading.
1215
1216 =cut
1217
1218 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1219
1220 =item $c->prepare_request
1221
1222 Prepare the engine request.
1223
1224 =cut
1225
1226 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1227
1228 =item $c->prepare_uploads
1229
1230 Prepare uploads.
1231
1232 =cut
1233
1234 sub prepare_uploads {
1235     my $c = shift;
1236
1237     $c->engine->prepare_uploads( $c, @_ );
1238
1239     if ( $c->debug && keys %{ $c->request->uploads } ) {
1240         my $t = Text::ASCIITable->new;
1241         $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1242         $t->setColWidth( 'Key',      12, 1 );
1243         $t->setColWidth( 'Filename', 28, 1 );
1244         $t->setColWidth( 'Type',     18, 1 );
1245         $t->setColWidth( 'Size',     9,  1 );
1246         $t->alignCol( 'Size', 'left' );
1247         for my $key ( sort keys %{ $c->request->uploads } ) {
1248             my $upload = $c->request->uploads->{$key};
1249             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1250                 $t->addRow( $key, $u->filename, $u->type, $u->size );
1251             }
1252         }
1253         $c->log->debug( "File Uploads are:\n" . $t->draw );
1254     }
1255 }
1256
1257 =item $c->prepare_write
1258
1259 Prepare the output for writing.
1260
1261 =cut
1262
1263 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1264
1265 =item $c->read( [$maxlength] )
1266
1267 Read a chunk of data from the request body.  This method is designed to be
1268 used in a while loop, reading $maxlength bytes on every call.  $maxlength
1269 defaults to the size of the request if not specified.
1270
1271 You have to set MyApp->config->{parse_on_demand} to use this directly.
1272
1273 =cut
1274
1275 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1276
1277 =item $c->run
1278
1279 Starts the engine.
1280
1281 =cut
1282
1283 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1284
1285 =item $c->set_action( $action, $code, $namespace, $attrs )
1286
1287 Set an action in a given namespace.
1288
1289 =cut
1290
1291 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1292
1293 =item $c->setup_actions($component)
1294
1295 Setup actions for a component.
1296
1297 =cut
1298
1299 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1300
1301 =item $c->setup_components
1302
1303 Setup components.
1304
1305 =cut
1306
1307 sub setup_components {
1308     my $class = shift;
1309
1310     my $callback = sub {
1311         my ( $component, $context ) = @_;
1312
1313         unless ( $component->isa('Catalyst::Base') ) {
1314             return $component;
1315         }
1316
1317         my $suffix = Catalyst::Utils::class2classsuffix($component);
1318         my $config = $class->config->{$suffix} || {};
1319
1320         my $instance;
1321
1322         eval { $instance = $component->new( $context, $config ); };
1323
1324         if ( my $error = $@ ) {
1325
1326             chomp $error;
1327
1328             Catalyst::Exception->throw( message =>
1329                   qq/Couldn't instantiate component "$component", "$error"/ );
1330         }
1331
1332         Catalyst::Exception->throw( message =>
1333 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1334           )
1335           unless ref $instance;
1336         return $instance;
1337     };
1338
1339     eval {
1340         Module::Pluggable::Fast->import(
1341             name   => '_catalyst_components',
1342             search => [
1343                 "$class\::Controller", "$class\::C",
1344                 "$class\::Model",      "$class\::M",
1345                 "$class\::View",       "$class\::V"
1346             ],
1347             callback => $callback
1348         );
1349     };
1350
1351     if ( my $error = $@ ) {
1352
1353         chomp $error;
1354
1355         Catalyst::Exception->throw(
1356             message => qq/Couldn't load components "$error"/ );
1357     }
1358
1359     for my $component ( $class->_catalyst_components($class) ) {
1360         $class->components->{ ref $component || $component } = $component;
1361     }
1362 }
1363
1364 =item $c->setup_dispatcher
1365
1366 =cut
1367
1368 sub setup_dispatcher {
1369     my ( $class, $dispatcher ) = @_;
1370
1371     if ($dispatcher) {
1372         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1373     }
1374
1375     if ( $ENV{CATALYST_DISPATCHER} ) {
1376         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1377     }
1378
1379     if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1380         $dispatcher =
1381           'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1382     }
1383
1384     unless ($dispatcher) {
1385         $dispatcher = 'Catalyst::Dispatcher';
1386     }
1387
1388     $dispatcher->require;
1389
1390     if ($@) {
1391         Catalyst::Exception->throw(
1392             message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1393     }
1394
1395     # dispatcher instance
1396     $class->dispatcher( $dispatcher->new );
1397 }
1398
1399 =item $c->setup_engine
1400
1401 =cut
1402
1403 sub setup_engine {
1404     my ( $class, $engine ) = @_;
1405
1406     if ($engine) {
1407         $engine = 'Catalyst::Engine::' . $engine;
1408     }
1409
1410     if ( $ENV{CATALYST_ENGINE} ) {
1411         $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1412     }
1413
1414     if ( $ENV{ uc($class) . '_ENGINE' } ) {
1415         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1416     }
1417
1418     if ( !$engine && $ENV{MOD_PERL} ) {
1419
1420         # create the apache method
1421         {
1422             no strict 'refs';
1423             *{"$class\::apache"} = sub { shift->engine->apache };
1424         }
1425
1426         my ( $software, $version ) =
1427           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1428
1429         $version =~ s/_//g;
1430         $version =~ s/(\.[^.]+)\./$1/g;
1431
1432         if ( $software eq 'mod_perl' ) {
1433
1434             if ( $version >= 1.99922 ) {
1435                 $engine = 'Catalyst::Engine::Apache2::MP20';
1436             }
1437
1438             elsif ( $version >= 1.9901 ) {
1439                 $engine = 'Catalyst::Engine::Apache2::MP19';
1440             }
1441
1442             elsif ( $version >= 1.24 ) {
1443                 $engine = 'Catalyst::Engine::Apache::MP13';
1444             }
1445
1446             else {
1447                 Catalyst::Exception->throw( message =>
1448                       qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1449             }
1450
1451             # install the correct mod_perl handler
1452             if ( $version >= 1.9901 ) {
1453                 *handler = sub  : method {
1454                     shift->handle_request(@_);
1455                 };
1456             }
1457             else {
1458                 *handler = sub ($$) { shift->handle_request(@_) };
1459             }
1460
1461         }
1462
1463         elsif ( $software eq 'Zeus-Perl' ) {
1464             $engine = 'Catalyst::Engine::Zeus';
1465         }
1466
1467         else {
1468             Catalyst::Exception->throw(
1469                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1470         }
1471     }
1472
1473     unless ($engine) {
1474         $engine = 'Catalyst::Engine::CGI';
1475     }
1476
1477     $engine->require;
1478
1479     if ($@) {
1480         Catalyst::Exception->throw( message =>
1481 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1482         );
1483     }
1484
1485     # check for old engines that are no longer compatible
1486     my $old_engine;
1487     if (   $engine->isa('Catalyst::Engine::Apache')
1488         && ! Catalyst::Engine::Apache->VERSION )
1489     {
1490         $old_engine = 1;
1491     }
1492
1493     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1494          && Catalyst::Engine::Server->VERSION le '0.02' )
1495     {
1496         $old_engine = 1;
1497     }
1498
1499     elsif ( $engine->isa('Catalyst::Engine::HTTP::POE')
1500          && $engine->VERSION eq '0.01' )
1501     {
1502         $old_engine = 1;
1503     }
1504
1505     elsif ( $engine->isa('Catalyst::Engine::Zeus')
1506          && $engine->VERSION eq '0.01' )
1507     {
1508         $old_engine = 1;
1509     }
1510
1511     if ($old_engine) {
1512         Catalyst::Exception->throw( message =>
1513             qq/Engine "$engine" is not supported by this version of Catalyst/
1514         );
1515     }
1516
1517     # engine instance
1518     $class->engine( $engine->new );
1519 }
1520
1521 =item $c->setup_home
1522
1523 =cut
1524
1525 sub setup_home {
1526     my ( $class, $home ) = @_;
1527
1528     if ( $ENV{CATALYST_HOME} ) {
1529         $home = $ENV{CATALYST_HOME};
1530     }
1531
1532     if ( $ENV{ uc($class) . '_HOME' } ) {
1533         $home = $ENV{ uc($class) . '_HOME' };
1534     }
1535
1536     unless ($home) {
1537         $home = Catalyst::Utils::home($class);
1538     }
1539
1540     if ($home) {
1541         $class->config->{home} ||= $home;
1542         $class->config->{root} ||= dir($home)->subdir('root');
1543     }
1544 }
1545
1546 =item $c->setup_log
1547
1548 =cut
1549
1550 sub setup_log {
1551     my ( $class, $debug ) = @_;
1552
1553     unless ( $class->log ) {
1554         $class->log( Catalyst::Log->new );
1555     }
1556
1557     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1558         no strict 'refs';
1559         *{"$class\::debug"} = sub { 1 };
1560         $class->log->debug('Debug messages enabled');
1561     }
1562 }
1563
1564 =item $c->setup_plugins
1565
1566 =cut
1567
1568 sub setup_plugins {
1569     my ( $class, $plugins ) = @_;
1570
1571     $plugins ||= [];
1572     for my $plugin ( reverse @$plugins ) {
1573
1574         $plugin = "Catalyst::Plugin::$plugin";
1575
1576         $plugin->require;
1577
1578         if ($@) {
1579             Catalyst::Exception->throw(
1580                 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1581         }
1582
1583         {
1584             no strict 'refs';
1585             unshift @{"$class\::ISA"}, $plugin;
1586         }
1587     }
1588 }
1589
1590 =item $c->write( $data )
1591
1592 Writes $data to the output stream.  When using this method directly, you will
1593 need to manually set the Content-Length header to the length of your output
1594 data, if known.
1595
1596 =cut
1597
1598 sub write {
1599     my $c = shift;
1600
1601     # Finalize headers if someone manually writes output
1602     $c->finalize_headers;
1603
1604     return $c->engine->write( $c, @_ );
1605 }
1606
1607 =item version
1608
1609 Returns the Catalyst version number. mostly useful for powered by messages
1610 in template systems.
1611
1612 =cut
1613
1614 sub version { return $Catalyst::VERSION }
1615
1616 =back
1617
1618 =head1 INTERNAL ACTIONS
1619
1620 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1621 C<_ACTION> and C<_END>, these are by default not shown in the private
1622 action table.
1623
1624 But you can deactivate this with a config parameter.
1625
1626     MyApp->config->{show_internal_actions} = 1;
1627
1628 =head1 CASE SENSITIVITY
1629
1630 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1631 C</foo/bar>.
1632
1633 But you can activate case sensitivity with a config parameter.
1634
1635     MyApp->config->{case_sensitive} = 1;
1636
1637 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1638
1639 =head1 ON-DEMAND PARSER
1640
1641 The request body is usually parsed at the beginning of a request,
1642 but if you want to handle input yourself or speed things up a bit
1643 you can enable on-demand parsing with a config parameter.
1644
1645     MyApp->config->{parse_on_demand} = 1;
1646
1647 =head1 PROXY SUPPORT
1648
1649 Many production servers operate using the common double-server approach, with
1650 a lightweight frontend web server passing requests to a larger backend
1651 server.  An application running on the backend server must deal with two
1652 problems: the remote user always appears to be '127.0.0.1' and the server's
1653 hostname will appear to be 'localhost' regardless of the virtual host the
1654 user connected through.
1655
1656 Catalyst will automatically detect this situation when you are running both
1657 the frontend and backend servers on the same machine.  The following changes
1658 are made to the request.
1659
1660     $c->req->address is set to the user's real IP address, as read from the
1661     HTTP_X_FORWARDED_FOR header.
1662
1663     The host value for $c->req->base and $c->req->uri is set to the real host,
1664     as read from the HTTP_X_FORWARDED_HOST header.
1665
1666 Obviously, your web server must support these 2 headers for this to work.
1667
1668 In a more complex server farm environment where you may have your frontend
1669 proxy server(s) on different machines, you will need to set a configuration
1670 option to tell Catalyst to read the proxied data from the headers.
1671
1672     MyApp->config->{using_frontend_proxy} = 1;
1673
1674 If you do not wish to use the proxy support at all, you may set:
1675
1676     MyApp->config->{ignore_frontend_proxy} = 1;
1677
1678 =head1 THREAD SAFETY
1679
1680 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1681 and the standalone forking HTTP server on Windows.  We believe the Catalyst
1682 core to be thread-safe.
1683
1684 If you plan to operate in a threaded environment, remember that all other
1685 modules you are using must also be thread-safe.  Some modules, most notably
1686 DBD::SQLite, are not thread-safe.
1687
1688 =head1 SUPPORT
1689
1690 IRC:
1691
1692     Join #catalyst on irc.perl.org.
1693
1694 Mailing-Lists:
1695
1696     http://lists.rawmode.org/mailman/listinfo/catalyst
1697     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1698
1699 Web:
1700
1701     http://catalyst.perl.org
1702
1703 =head1 SEE ALSO
1704
1705 =over 4
1706
1707 =item L<Catalyst::Manual> - The Catalyst Manual
1708
1709 =item L<Catalyst::Engine> - Core Engine
1710
1711 =item L<Catalyst::Log> - The Log Class.
1712
1713 =item L<Catalyst::Request> - The Request Object
1714
1715 =item L<Catalyst::Response> - The Response Object
1716
1717 =item L<Catalyst::Test> - The test suite.
1718
1719 =back
1720
1721 =head1 CREDITS
1722
1723 Andy Grundman
1724
1725 Andy Wardley
1726
1727 Andreas Marienborg
1728
1729 Andrew Bramble
1730
1731 Andrew Ford
1732
1733 Andrew Ruthven
1734
1735 Arthur Bergman
1736
1737 Autrijus Tang
1738
1739 Christian Hansen
1740
1741 Christopher Hicks
1742
1743 Dan Sully
1744
1745 Danijel Milicevic
1746
1747 David Naughton
1748
1749 Gary Ashton Jones
1750
1751 Geoff Richards
1752
1753 Jesse Sheidlower
1754
1755 Jesse Vincent
1756
1757 Jody Belka
1758
1759 Johan Lindstrom
1760
1761 Juan Camacho
1762
1763 Leon Brocard
1764
1765 Marcus Ramberg
1766
1767 Matt S Trout
1768
1769 Robert Sedlacek
1770
1771 Sam Vilain
1772
1773 Tatsuhiko Miyagawa
1774
1775 Ulf Edvinsson
1776
1777 Yuval Kogman
1778
1779 =head1 AUTHOR
1780
1781 Sebastian Riedel, C<sri@oook.de>
1782
1783 =head1 LICENSE
1784
1785 This library is free software, you can redistribute it and/or modify it under
1786 the same terms as Perl itself.
1787
1788 =cut
1789
1790 1;