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     $c->prepare_action;
1205     my $method  = $c->req->method  || '';
1206     my $path    = $c->req->path    || '';
1207     my $address = $c->req->address || '';
1208
1209     $c->log->debug(qq/"$method" request for "$path" from $address/)
1210       if $c->debug;
1211
1212     return $c;
1213 }
1214
1215 =item $c->prepare_action
1216
1217 Prepares action.
1218
1219 =cut
1220
1221 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1222
1223 =item $c->prepare_body
1224
1225 Prepares message body.
1226
1227 =cut
1228
1229 sub prepare_body {
1230     my $c = shift;
1231
1232     # Do we run for the first time?
1233     return if defined $c->request->{_body};
1234
1235     # Initialize on-demand data
1236     $c->engine->prepare_body( $c, @_ );
1237     $c->prepare_parameters;
1238     $c->prepare_uploads;
1239
1240     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1241         my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1242         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1243             my $param = $c->req->body_parameters->{$key};
1244             my $value = defined($param) ? $param : '';
1245             $t->row( $key,
1246                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1247         }
1248         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1249     }
1250 }
1251
1252 =item $c->prepare_body_chunk( $chunk )
1253
1254 Prepares a chunk of data before sending it to L<HTTP::Body>.
1255
1256 =cut
1257
1258 sub prepare_body_chunk {
1259     my $c = shift;
1260     $c->engine->prepare_body_chunk( $c, @_ );
1261 }
1262
1263 =item $c->prepare_body_parameters
1264
1265 Prepares body parameters.
1266
1267 =cut
1268
1269 sub prepare_body_parameters {
1270     my $c = shift;
1271     $c->engine->prepare_body_parameters( $c, @_ );
1272 }
1273
1274 =item $c->prepare_connection
1275
1276 Prepares connection.
1277
1278 =cut
1279
1280 sub prepare_connection {
1281     my $c = shift;
1282     $c->engine->prepare_connection( $c, @_ );
1283 }
1284
1285 =item $c->prepare_cookies
1286
1287 Prepares cookies.
1288
1289 =cut
1290
1291 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1292
1293 =item $c->prepare_headers
1294
1295 Prepares headers.
1296
1297 =cut
1298
1299 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1300
1301 =item $c->prepare_parameters
1302
1303 Prepares parameters.
1304
1305 =cut
1306
1307 sub prepare_parameters {
1308     my $c = shift;
1309     $c->prepare_body_parameters;
1310     $c->engine->prepare_parameters( $c, @_ );
1311 }
1312
1313 =item $c->prepare_path
1314
1315 Prepares path and base.
1316
1317 =cut
1318
1319 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1320
1321 =item $c->prepare_query_parameters
1322
1323 Prepares query parameters.
1324
1325 =cut
1326
1327 sub prepare_query_parameters {
1328     my $c = shift;
1329
1330     $c->engine->prepare_query_parameters( $c, @_ );
1331
1332     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1333         my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1334         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1335             my $param = $c->req->query_parameters->{$key};
1336             my $value = defined($param) ? $param : '';
1337             $t->row( $key,
1338                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1339         }
1340         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1341     }
1342 }
1343
1344 =item $c->prepare_read
1345
1346 Prepares the input for reading.
1347
1348 =cut
1349
1350 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1351
1352 =item $c->prepare_request
1353
1354 Prepares the engine request.
1355
1356 =cut
1357
1358 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1359
1360 =item $c->prepare_uploads
1361
1362 Prepares uploads.
1363
1364 =cut
1365
1366 sub prepare_uploads {
1367     my $c = shift;
1368
1369     $c->engine->prepare_uploads( $c, @_ );
1370
1371     if ( $c->debug && keys %{ $c->request->uploads } ) {
1372         my $t = Text::SimpleTable->new(
1373             [ 12, 'Key' ],
1374             [ 28, 'Filename' ],
1375             [ 18, 'Type' ],
1376             [ 9,  'Size' ]
1377         );
1378         for my $key ( sort keys %{ $c->request->uploads } ) {
1379             my $upload = $c->request->uploads->{$key};
1380             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1381                 $t->row( $key, $u->filename, $u->type, $u->size );
1382             }
1383         }
1384         $c->log->debug( "File Uploads are:\n" . $t->draw );
1385     }
1386 }
1387
1388 =item $c->prepare_write
1389
1390 Prepares the output for writing.
1391
1392 =cut
1393
1394 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1395
1396 =item $c->request_class
1397
1398 Returns or sets the request class.
1399
1400 =item $c->response_class
1401
1402 Returns or sets the response class.
1403
1404 =item $c->read( [$maxlength] )
1405
1406 Reads a chunk of data from the request body.  This method is designed to be
1407 used in a while loop, reading $maxlength bytes on every call.  $maxlength
1408 defaults to the size of the request if not specified.
1409
1410 You have to set MyApp->config->{parse_on_demand} to use this directly.
1411
1412 =cut
1413
1414 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1415
1416 =item $c->run
1417
1418 Starts the engine.
1419
1420 =cut
1421
1422 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1423
1424 =item $c->set_action( $action, $code, $namespace, $attrs )
1425
1426 Sets an action in a given namespace.
1427
1428 =cut
1429
1430 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1431
1432 =item $c->setup_actions($component)
1433
1434 Sets up actions for a component.
1435
1436 =cut
1437
1438 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1439
1440 =item $c->setup_components
1441
1442 Sets up components.
1443
1444 =cut
1445
1446 sub setup_components {
1447     my $class = shift;
1448
1449     my $callback = sub {
1450         my ( $component, $context ) = @_;
1451
1452         unless ( $component->isa('Catalyst::Component') ) {
1453             return $component;
1454         }
1455
1456         my $suffix = Catalyst::Utils::class2classsuffix($component);
1457         my $config = $class->config->{$suffix} || {};
1458
1459         my $instance;
1460
1461         eval { $instance = $component->new( $context, $config ); };
1462
1463         if ( my $error = $@ ) {
1464
1465             chomp $error;
1466
1467             Catalyst::Exception->throw( message =>
1468                   qq/Couldn't instantiate component "$component", "$error"/ );
1469         }
1470
1471         Catalyst::Exception->throw( message =>
1472 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1473           )
1474           unless ref $instance;
1475         return $instance;
1476     };
1477
1478     eval {
1479         Module::Pluggable::Fast->import(
1480             name   => '_catalyst_components',
1481             search => [
1482                 "$class\::Controller", "$class\::C",
1483                 "$class\::Model",      "$class\::M",
1484                 "$class\::View",       "$class\::V"
1485             ],
1486             callback => $callback
1487         );
1488     };
1489
1490     if ( my $error = $@ ) {
1491
1492         chomp $error;
1493
1494         Catalyst::Exception->throw(
1495             message => qq/Couldn't load components "$error"/ );
1496     }
1497
1498     for my $component ( $class->_catalyst_components($class) ) {
1499         $class->components->{ ref $component || $component } = $component;
1500     }
1501 }
1502
1503 =item $c->setup_dispatcher
1504
1505 =cut
1506
1507 sub setup_dispatcher {
1508     my ( $class, $dispatcher ) = @_;
1509
1510     if ($dispatcher) {
1511         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1512     }
1513
1514     if ( $ENV{CATALYST_DISPATCHER} ) {
1515         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1516     }
1517
1518     if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1519         $dispatcher =
1520           'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1521     }
1522
1523     unless ($dispatcher) {
1524         $dispatcher = $class->dispatcher_class;
1525     }
1526
1527     $dispatcher->require;
1528
1529     if ($@) {
1530         Catalyst::Exception->throw(
1531             message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1532     }
1533
1534     # dispatcher instance
1535     $class->dispatcher( $dispatcher->new );
1536 }
1537
1538 =item $c->setup_engine
1539
1540 =cut
1541
1542 sub setup_engine {
1543     my ( $class, $engine ) = @_;
1544
1545     if ($engine) {
1546         $engine = 'Catalyst::Engine::' . $engine;
1547     }
1548
1549     if ( $ENV{CATALYST_ENGINE} ) {
1550         $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1551     }
1552
1553     if ( $ENV{ uc($class) . '_ENGINE' } ) {
1554         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1555     }
1556
1557     if ( !$engine && $ENV{MOD_PERL} ) {
1558
1559         # create the apache method
1560         {
1561             no strict 'refs';
1562             *{"$class\::apache"} = sub { shift->engine->apache };
1563         }
1564
1565         my ( $software, $version ) =
1566           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1567
1568         $version =~ s/_//g;
1569         $version =~ s/(\.[^.]+)\./$1/g;
1570
1571         if ( $software eq 'mod_perl' ) {
1572
1573             if ( $version >= 1.99922 ) {
1574                 $engine = 'Catalyst::Engine::Apache2::MP20';
1575             }
1576
1577             elsif ( $version >= 1.9901 ) {
1578                 $engine = 'Catalyst::Engine::Apache2::MP19';
1579             }
1580
1581             elsif ( $version >= 1.24 ) {
1582                 $engine = 'Catalyst::Engine::Apache::MP13';
1583             }
1584
1585             else {
1586                 Catalyst::Exception->throw( message =>
1587                       qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1588             }
1589
1590             # install the correct mod_perl handler
1591             if ( $version >= 1.9901 ) {
1592                 *handler = sub  : method {
1593                     shift->handle_request(@_);
1594                 };
1595             }
1596             else {
1597                 *handler = sub ($$) { shift->handle_request(@_) };
1598             }
1599
1600         }
1601
1602         elsif ( $software eq 'Zeus-Perl' ) {
1603             $engine = 'Catalyst::Engine::Zeus';
1604         }
1605
1606         else {
1607             Catalyst::Exception->throw(
1608                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1609         }
1610     }
1611
1612     unless ($engine) {
1613         $engine = $class->engine_class;
1614     }
1615
1616     $engine->require;
1617
1618     if ($@) {
1619         Catalyst::Exception->throw( message =>
1620 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1621         );
1622     }
1623
1624     # check for old engines that are no longer compatible
1625     my $old_engine;
1626     if ( $engine->isa('Catalyst::Engine::Apache')
1627         && !Catalyst::Engine::Apache->VERSION )
1628     {
1629         $old_engine = 1;
1630     }
1631
1632     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1633         && Catalyst::Engine::Server->VERSION le '0.02' )
1634     {
1635         $old_engine = 1;
1636     }
1637
1638     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1639         && $engine->VERSION eq '0.01' )
1640     {
1641         $old_engine = 1;
1642     }
1643
1644     elsif ($engine->isa('Catalyst::Engine::Zeus')
1645         && $engine->VERSION eq '0.01' )
1646     {
1647         $old_engine = 1;
1648     }
1649
1650     if ($old_engine) {
1651         Catalyst::Exception->throw( message =>
1652               qq/Engine "$engine" is not supported by this version of Catalyst/
1653         );
1654     }
1655
1656     # engine instance
1657     $class->engine( $engine->new );
1658 }
1659
1660 =item $c->setup_home
1661
1662 =cut
1663
1664 sub setup_home {
1665     my ( $class, $home ) = @_;
1666
1667     if ( $ENV{CATALYST_HOME} ) {
1668         $home = $ENV{CATALYST_HOME};
1669     }
1670
1671     if ( $ENV{ uc($class) . '_HOME' } ) {
1672         $home = $ENV{ uc($class) . '_HOME' };
1673     }
1674
1675     unless ($home) {
1676         $home = Catalyst::Utils::home($class);
1677     }
1678
1679     if ($home) {
1680         $class->config->{home} ||= $home;
1681         $class->config->{root} ||= dir($home)->subdir('root');
1682     }
1683 }
1684
1685 =item $c->setup_log
1686
1687 =cut
1688
1689 sub setup_log {
1690     my ( $class, $debug ) = @_;
1691
1692     unless ( $class->log ) {
1693         $class->log( Catalyst::Log->new );
1694     }
1695
1696     my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1697
1698     if (
1699           ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1700         ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1701         : $debug
1702       )
1703     {
1704         no strict 'refs';
1705         *{"$class\::debug"} = sub { 1 };
1706         $class->log->debug('Debug messages enabled');
1707     }
1708 }
1709
1710 =item $c->setup_plugins
1711
1712 =cut
1713
1714 sub setup_plugins {
1715     my ( $class, $plugins ) = @_;
1716
1717     $plugins ||= [];
1718     for my $plugin ( reverse @$plugins ) {
1719
1720         $plugin = "Catalyst::Plugin::$plugin";
1721
1722         $plugin->require;
1723
1724         if ($@) {
1725             Catalyst::Exception->throw(
1726                 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1727         }
1728
1729         {
1730             no strict 'refs';
1731             unshift @{"$class\::ISA"}, $plugin;
1732         }
1733     }
1734 }
1735
1736 =item $c->stack
1737
1738 Returns the stack.
1739
1740 =item $c->write( $data )
1741
1742 Writes $data to the output stream.  When using this method directly, you will
1743 need to manually set the Content-Length header to the length of your output
1744 data, if known.
1745
1746 =cut
1747
1748 sub write {
1749     my $c = shift;
1750
1751     # Finalize headers if someone manually writes output
1752     $c->finalize_headers;
1753
1754     return $c->engine->write( $c, @_ );
1755 }
1756
1757 =item version
1758
1759 Returns the Catalyst version number. Mostly useful for "powered by" messages
1760 in template systems.
1761
1762 =cut
1763
1764 sub version { return $Catalyst::VERSION }
1765
1766 =back
1767
1768 =head1 INTERNAL ACTIONS
1769
1770 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1771 C<_ACTION> and C<_END>. These are by default not shown in the private
1772 action table, but you can make them visible with a config parameter.
1773
1774     MyApp->config->{show_internal_actions} = 1;
1775
1776 =head1 CASE SENSITIVITY
1777
1778 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
1779 mapped to C</foo/bar>. You can activate case sensitivity with a config
1780 parameter.
1781
1782     MyApp->config->{case_sensitive} = 1;
1783
1784 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
1785
1786 =head1 ON-DEMAND PARSER
1787
1788 The request body is usually parsed at the beginning of a request,
1789 but if you want to handle input yourself or speed things up a bit,
1790 you can enable on-demand parsing with a config parameter.
1791
1792     MyApp->config->{parse_on_demand} = 1;
1793
1794 =head1 PROXY SUPPORT
1795
1796 Many production servers operate using the common double-server approach, with
1797 a lightweight frontend web server passing requests to a larger backend
1798 server.  An application running on the backend server must deal with two
1799 problems: the remote user always appears to be C<127.0.0.1> and the server's
1800 hostname will appear to be C<localhost> regardless of the virtual host that
1801 the user connected through.
1802
1803 Catalyst will automatically detect this situation when you are running the
1804 frontend and backend servers on the same machine. The following changes
1805 are made to the request.
1806
1807     $c->req->address is set to the user's real IP address, as read from the
1808     HTTP X-Forwarded-For header.
1809
1810     The host value for $c->req->base and $c->req->uri is set to the real host,
1811     as read from the HTTP X-Forwarded-Host header.
1812
1813 Obviously, your web server must support these headers for this to work.
1814
1815 In a more complex server farm environment where you may have your frontend
1816 proxy server(s) on different machines, you will need to set a configuration
1817 option to tell Catalyst to read the proxied data from the headers.
1818
1819     MyApp->config->{using_frontend_proxy} = 1;
1820
1821 If you do not wish to use the proxy support at all, you may set:
1822
1823     MyApp->config->{ignore_frontend_proxy} = 1;
1824
1825 =head1 THREAD SAFETY
1826
1827 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1828 and the standalone forking HTTP server on Windows. We believe the Catalyst
1829 core to be thread-safe.
1830
1831 If you plan to operate in a threaded environment, remember that all other
1832 modules you are using must also be thread-safe. Some modules, most notably
1833 L<DBD::SQLite>, are not thread-safe.
1834
1835 =head1 SUPPORT
1836
1837 IRC:
1838
1839     Join #catalyst on irc.perl.org.
1840
1841 Mailing Lists:
1842
1843     http://lists.rawmode.org/mailman/listinfo/catalyst
1844     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1845
1846 Web:
1847
1848     http://catalyst.perl.org
1849
1850 Wiki:
1851
1852     http://dev.catalyst.perl.org
1853
1854 =head1 SEE ALSO
1855
1856 =over 4
1857
1858 =item L<Catalyst::Manual> - The Catalyst Manual
1859
1860 =item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1861
1862 =item L<Catalyst::Engine> - Core Engine
1863
1864 =item L<Catalyst::Log> - The Log Class.
1865
1866 =item L<Catalyst::Request> - The Request Object
1867
1868 =item L<Catalyst::Response> - The Response Object
1869
1870 =item L<Catalyst::Test> - The test suite.
1871
1872 =back
1873
1874 =head1 CREDITS
1875
1876 Andy Grundman
1877
1878 Andy Wardley
1879
1880 Andreas Marienborg
1881
1882 Andrew Bramble
1883
1884 Andrew Ford
1885
1886 Andrew Ruthven
1887
1888 Arthur Bergman
1889
1890 Autrijus Tang
1891
1892 Brian Cassidy
1893
1894 Christian Hansen
1895
1896 Christopher Hicks
1897
1898 Dan Sully
1899
1900 Danijel Milicevic
1901
1902 David Kamholz
1903
1904 David Naughton
1905
1906 Gary Ashton Jones
1907
1908 Geoff Richards
1909
1910 Jesse Sheidlower
1911
1912 Jesse Vincent
1913
1914 Jody Belka
1915
1916 Johan Lindstrom
1917
1918 Juan Camacho
1919
1920 Leon Brocard
1921
1922 Marcus Ramberg
1923
1924 Matt S Trout
1925
1926 Robert Sedlacek
1927
1928 Sam Vilain
1929
1930 Sascha Kiefer
1931
1932 Tatsuhiko Miyagawa
1933
1934 Ulf Edvinsson
1935
1936 Yuval Kogman
1937
1938 =head1 AUTHOR
1939
1940 Sebastian Riedel, C<sri@oook.de>
1941
1942 =head1 LICENSE
1943
1944 This library is free software, you can redistribute it and/or modify it under
1945 the same terms as Perl itself.
1946
1947 =cut
1948
1949 1;