lib/Catalyst.pm

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