lib/Catalyst.pm

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