lib/Catalyst.pm

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