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