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