lib/Catalyst.pm

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