lib/Catalyst.pm

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