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