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