lib/Catalyst.pm

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