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