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