lib/Catalyst.pm

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