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