lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use strict;
   4 use base 'Catalyst::Component';
   5 use bytes;
   6 use Catalyst::Exception;
   7 use Catalyst::Log;
   8 use Catalyst::Request;
   9 use Catalyst::Request::Upload;
  10 use Catalyst::Response;
  11 use Catalyst::Utils;
  12 use Catalyst::Controller;
  13 use Devel::InnerPackage ();
  14 use File::stat;
  15 use Module::Pluggable::Object ();
  16 use NEXT;
  17 use Text::SimpleTable ();
  18 use Path::Class::Dir ();
  19 use Path::Class::File ();
  20 use Time::HiRes qw/gettimeofday tv_interval/;
  21 use URI ();
  22 use URI::http;
  23 use URI::https;
  24 use Scalar::Util qw/weaken blessed/;
  25 use Tree::Simple qw/use_weak_refs/;
  26 use Tree::Simple::Visitor::FindByUID;
  27 use attributes;
  28 use utf8;
  29 use Carp qw/croak carp/;
  30
  31 BEGIN { require 5.008001; }
  32
  33 __PACKAGE__->mk_accessors(
  34     qw/counter request response state action stack namespace stats/
  35 );
  36
  37 sub depth { scalar @{ shift->stack || [] }; }
  38
  39 # Laziness++
  40 *comp = \&component;
  41 *req  = \&request;
  42 *res  = \&response;
  43
  44 # For backwards compatibility
  45 *finalize_output = \&finalize_body;
  46
  47 # For statistics
  48 our $COUNT     = 1;
  49 our $START     = time;
  50 our $RECURSION = 1000;
  51 our $DETACH    = "catalyst_detach\n";
  52 our $GO        = "catalyst_go\n";
  53
  54 __PACKAGE__->mk_classdata($_)
  55   for qw/components arguments dispatcher engine log dispatcher_class
  56   engine_class context_class request_class response_class stats_class
  57   setup_finished/;
  58
  59 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  60 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  61 __PACKAGE__->request_class('Catalyst::Request');
  62 __PACKAGE__->response_class('Catalyst::Response');
  63 __PACKAGE__->stats_class('Catalyst::Stats');
  64
  65 # Remember to update this in Catalyst::Runtime as well!
  66
  67 our $VERSION = '5.7099_02';
  68
  69 sub import {
  70     my ( $class, @arguments ) = @_;
  71
  72     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  73     # callers @ISA.
  74     return unless $class eq 'Catalyst';
  75
  76     my $caller = caller(0);
  77
  78     unless ( $caller->isa('Catalyst') ) {
  79         no strict 'refs';
  80         push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
  81     }
  82
  83     $caller->arguments( [@arguments] );
  84     $caller->setup_home;
  85 }
  86
  87 =head1 NAME
  88
  89 Catalyst - The Elegant MVC Web Application Framework
  90
  91 =head1 SYNOPSIS
  92
  93 See the L<Catalyst::Manual> distribution for comprehensive
  94 documentation and tutorials.
  95
  96     # Install Catalyst::Devel for helpers and other development tools
  97     # use the helper to create a new application
  98     catalyst.pl MyApp
  99
 100     # add models, views, controllers
 101     script/myapp_create.pl model MyDatabase DBIC::Schema create=dynamic dbi:SQLite:/path/to/db
 102     script/myapp_create.pl view MyTemplate TT
 103     script/myapp_create.pl controller Search
 104
 105     # built in testserver -- use -r to restart automatically on changes
 106     # --help to see all available options
 107     script/myapp_server.pl
 108
 109     # command line testing interface
 110     script/myapp_test.pl /yada
 111
 112     ### in lib/MyApp.pm
 113     use Catalyst qw/-Debug/; # include plugins here as well
 114
 115     ### In lib/MyApp/Controller/Root.pm (autocreated)
 116     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 117         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 118         $c->stash->{template} = 'foo.tt'; # set the template
 119         # lookup something from db -- stash vars are passed to TT
 120         $c->stash->{data} =
 121           $c->model('Database::Foo')->search( { country => $args[0] } );
 122         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 123             $c->forward( 'bar' ); # process another action
 124             # do something else after forward returns
 125         }
 126     }
 127
 128     # The foo.tt TT template can use the stash data from the database
 129     [% WHILE (item = data.next) %]
 130         [% item.foo %]
 131     [% END %]
 132
 133     # called for /bar/of/soap, /bar/of/soap/10, etc.
 134     sub bar : Path('/bar/of/soap') { ... }
 135
 136     # called for all actions, from the top-most controller downwards
 137     sub auto : Private {
 138         my ( $self, $c ) = @_;
 139         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 140             $c->res->redirect( '/login' ); # require login
 141             return 0; # abort request and go immediately to end()
 142         }
 143         return 1; # success; carry on to next action
 144     }
 145
 146     # called after all actions are finished
 147     sub end : Private {
 148         my ( $self, $c ) = @_;
 149         if ( scalar @{ $c->error } ) { ... } # handle errors
 150         return if $c->res->body; # already have a response
 151         $c->forward( 'MyApp::View::TT' ); # render template
 152     }
 153
 154     ### in MyApp/Controller/Foo.pm
 155     # called for /foo/bar
 156     sub bar : Local { ... }
 157
 158     # called for /blargle
 159     sub blargle : Global { ... }
 160
 161     # an index action matches /foo, but not /foo/1, etc.
 162     sub index : Private { ... }
 163
 164     ### in MyApp/Controller/Foo/Bar.pm
 165     # called for /foo/bar/baz
 166     sub baz : Local { ... }
 167
 168     # first Root auto is called, then Foo auto, then this
 169     sub auto : Private { ... }
 170
 171     # powerful regular expression paths are also possible
 172     sub details : Regex('^product/(\w+)/details$') {
 173         my ( $self, $c ) = @_;
 174         # extract the (\w+) from the URI
 175         my $product = $c->req->captures->[0];
 176     }
 177
 178 See L<Catalyst::Manual::Intro> for additional information.
 179
 180 =head1 DESCRIPTION
 181
 182 Catalyst is a modern framework for making web applications without the
 183 pain usually associated with this process. This document is a reference
 184 to the main Catalyst application. If you are a new user, we suggest you
 185 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 186
 187 See L<Catalyst::Manual> for more documentation.
 188
 189 Catalyst plugins can be loaded by naming them as arguments to the "use
 190 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 191 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 192 C<My::Module>.
 193
 194     use Catalyst qw/My::Module/;
 195
 196 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 197 fully qualify the name by using a unary plus:
 198
 199     use Catalyst qw/
 200         My::Module
 201         +Fully::Qualified::Plugin::Name
 202     /;
 203
 204 Special flags like C<-Debug> and C<-Engine> can also be specified as
 205 arguments when Catalyst is loaded:
 206
 207     use Catalyst qw/-Debug My::Module/;
 208
 209 The position of plugins and flags in the chain is important, because
 210 they are loaded in the order in which they appear.
 211
 212 The following flags are supported:
 213
 214 =head2 -Debug
 215
 216 Enables debug output. You can also force this setting from the system
 217 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 218 settings override the application, with <MYAPP>_DEBUG having the highest
 219 priority.
 220
 221 =head2 -Engine
 222
 223 Forces Catalyst to use a specific engine. Omit the
 224 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 225
 226     use Catalyst qw/-Engine=CGI/;
 227
 228 =head2 -Home
 229
 230 Forces Catalyst to use a specific home directory, e.g.:
 231
 232     use Catalyst qw[-Home=/usr/mst];
 233
 234 This can also be done in the shell environment by setting either the
 235 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 236 is replaced with the uppercased name of your application, any "::" in
 237 the name will be replaced with underscores, e.g. MyApp::Web should use
 238 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 239
 240 =head2 -Log
 241
 242 Specifies log level.
 243
 244 =head2 -Stats
 245
 246 Enables statistics collection and reporting. You can also force this setting
 247 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
 248 environment settings override the application, with <MYAPP>_STATS having the
 249 highest priority.
 250
 251 e.g.
 252
 253    use Catalyst qw/-Stats=1/
 254
 255 =head1 METHODS
 256
 257 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 258
 259 =head2 $c->action
 260
 261 Returns a L<Catalyst::Action> object for the current action, which
 262 stringifies to the action name. See L<Catalyst::Action>.
 263
 264 =head2 $c->namespace
 265
 266 Returns the namespace of the current action, i.e., the URI prefix
 267 corresponding to the controller of the current action. For example:
 268
 269     # in Controller::Foo::Bar
 270     $c->namespace; # returns 'foo/bar';
 271
 272 =head2 $c->request
 273
 274 =head2 $c->req
 275
 276 Returns the current L<Catalyst::Request> object, giving access to
 277 information about the current client request (including parameters,
 278 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 279
 280 =head2 REQUEST FLOW HANDLING
 281
 282 =head2 $c->forward( $action [, \@arguments ] )
 283
 284 =head2 $c->forward( $class, $method, [, \@arguments ] )
 285
 286 Forwards processing to another action, by its private name. If you give a
 287 class name but no method, C<process()> is called. You may also optionally
 288 pass arguments in an arrayref. The action will receive the arguments in
 289 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 290 C<< $c->req->args >> will be restored to the previous values.
 291
 292 Any data C<return>ed from the action forwarded to, will be returned by the
 293 call to forward.
 294
 295     my $foodata = $c->forward('/foo');
 296     $c->forward('index');
 297     $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
 298     $c->forward('MyApp::View::TT');
 299
 300 Note that forward implies an C<<eval { }>> around the call (actually
 301 C<execute> does), thus de-fatalizing all 'dies' within the called
 302 action. If you want C<die> to propagate you need to do something like:
 303
 304     $c->forward('foo');
 305     die $c->error if $c->error;
 306
 307 Or make sure to always return true values from your actions and write
 308 your code like this:
 309
 310     $c->forward('foo') || return;
 311
 312 =cut
 313
 314 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 315
 316 =head2 $c->detach( $action [, \@arguments ] )
 317
 318 =head2 $c->detach( $class, $method, [, \@arguments ] )
 319
 320 =head2 $c->detach()
 321
 322 The same as C<forward>, but doesn't return to the previous action when
 323 processing is finished.
 324
 325 When called with no arguments it escapes the processing chain entirely.
 326
 327 =cut
 328
 329 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 330
 331 =head2 $c->go( $action [, \@arguments ] )
 332
 333 =head2 $c->go( $class, $method, [, \@arguments ] )
 334
 335 Almost the same as C<detach>, but does a full dispatch, instead of just
 336 calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
 337 C<auto> and the method you go to is called, just like a new request.
 338
 339 C<$c-E<gt>stash> is kept unchanged.
 340
 341 =cut
 342
 343 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 344
 345 =head2 $c->response
 346
 347 =head2 $c->res
 348
 349 Returns the current L<Catalyst::Response> object, see there for details.
 350
 351 =head2 $c->stash
 352
 353 Returns a hashref to the stash, which may be used to store data and pass
 354 it between components during a request. You can also set hash keys by
 355 passing arguments. The stash is automatically sent to the view. The
 356 stash is cleared at the end of a request; it cannot be used for
 357 persistent storage (for this you must use a session; see
 358 L<Catalyst::Plugin::Session> for a complete system integrated with
 359 Catalyst).
 360
 361     $c->stash->{foo} = $bar;
 362     $c->stash( { moose => 'majestic', qux => 0 } );
 363     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 364
 365     # stash is automatically passed to the view for use in a template
 366     $c->forward( 'MyApp::View::TT' );
 367
 368 =cut
 369
 370 sub stash {
 371     my $c = shift;
 372     if (@_) {
 373         my $stash = @_ > 1 ? {@_} : $_[0];
 374         croak('stash takes a hash or hashref') unless ref $stash;
 375         foreach my $key ( keys %$stash ) {
 376             $c->{stash}->{$key} = $stash->{$key};
 377         }
 378     }
 379     return $c->{stash};
 380 }
 381
 382 =head2 $c->error
 383
 384 =head2 $c->error($error, ...)
 385
 386 =head2 $c->error($arrayref)
 387
 388 Returns an arrayref containing error messages.  If Catalyst encounters an
 389 error while processing a request, it stores the error in $c->error.  This
 390 method should only be used to store fatal error messages.
 391
 392     my @error = @{ $c->error };
 393
 394 Add a new error.
 395
 396     $c->error('Something bad happened');
 397
 398 =cut
 399
 400 sub error {
 401     my $c = shift;
 402     if ( $_[0] ) {
 403         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 404         croak @$error unless ref $c;
 405         push @{ $c->{error} }, @$error;
 406     }
 407     elsif ( defined $_[0] ) { $c->{error} = undef }
 408     return $c->{error} || [];
 409 }
 410
 411
 412 =head2 $c->state
 413
 414 Contains the return value of the last executed action.
 415
 416 =head2 $c->clear_errors
 417
 418 Clear errors.  You probably don't want to clear the errors unless you are
 419 implementing a custom error screen.
 420
 421 This is equivalent to running
 422
 423     $c->error(0);
 424
 425 =cut
 426
 427 sub clear_errors {
 428     my $c = shift;
 429     $c->error(0);
 430 }
 431
 432 # search components given a name and some prefixes
 433 sub _comp_search_prefixes {
 434     my ( $c, $name, @prefixes ) = @_;
 435     my $appclass = ref $c || $c;
 436     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 437
 438     # map the original component name to the sub part that we will search against
 439     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 440         grep { /$filter/ } keys %{ $c->components };
 441
 442     # undef for a name will return all
 443     return keys %eligible if !defined $name;
 444
 445     my $query  = ref $name ? $name : qr/^$name$/i;
 446     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 447
 448     return map { $c->components->{ $_ } } @result if @result;
 449
 450     # if we were given a regexp to search against, we're done.
 451     return if ref $name;
 452
 453     # regexp fallback
 454     $query  = qr/$name/i;
 455     @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 456
 457     # no results? try against full names
 458     if( !@result ) {
 459         @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
 460     }
 461
 462     # don't warn if we didn't find any results, it just might not exist
 463     if( @result ) {
 464         $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
 465         $c->log->warn( 'Relying on the regexp fallback behavior for component resolution is unreliable and unsafe.' );
 466         $c->log->warn( 'If you really want to search, pass in a regexp as the argument.' );
 467     }
 468
 469     return @result;
 470 }
 471
 472 # Find possible names for a prefix
 473 sub _comp_names {
 474     my ( $c, @prefixes ) = @_;
 475     my $appclass = ref $c || $c;
 476
 477     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 478
 479     my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
 480     return @names;
 481 }
 482
 483 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 484 sub _filter_component {
 485     my ( $c, $comp, @args ) = @_;
 486
 487     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 488         return $comp->ACCEPT_CONTEXT( $c, @args );
 489     }
 490
 491     return $comp;
 492 }
 493
 494 =head2 COMPONENT ACCESSORS
 495
 496 =head2 $c->controller($name)
 497
 498 Gets a L<Catalyst::Controller> instance by name.
 499
 500     $c->controller('Foo')->do_stuff;
 501
 502 If the name is omitted, will return the controller for the dispatched
 503 action.
 504
 505 If you want to search for controllers, pass in a regexp as the argument.
 506
 507     # find all controllers that start with Foo
 508     my @foo_controllers = $c->controller(qr{^Foo});
 509
 510
 511 =cut
 512
 513 sub controller {
 514     my ( $c, $name, @args ) = @_;
 515
 516     if( $name ) {
 517         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
 518         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 519         return $c->_filter_component( $result[ 0 ], @args );
 520     }
 521
 522     return $c->component( $c->action->class );
 523 }
 524
 525 =head2 $c->model($name)
 526
 527 Gets a L<Catalyst::Model> instance by name.
 528
 529     $c->model('Foo')->do_stuff;
 530
 531 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 532
 533 If the name is omitted, it will look for
 534  - a model object in $c->stash->{current_model_instance}, then
 535  - a model name in $c->stash->{current_model}, then
 536  - a config setting 'default_model', or
 537  - check if there is only one model, and return it if that's the case.
 538
 539 If you want to search for models, pass in a regexp as the argument.
 540
 541     # find all models that start with Foo
 542     my @foo_models = $c->model(qr{^Foo});
 543
 544 =cut
 545
 546 sub model {
 547     my ( $c, $name, @args ) = @_;
 548
 549     if( $name ) {
 550         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
 551         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 552         return $c->_filter_component( $result[ 0 ], @args );
 553     }
 554
 555     if (ref $c) {
 556         return $c->stash->{current_model_instance}
 557           if $c->stash->{current_model_instance};
 558         return $c->model( $c->stash->{current_model} )
 559           if $c->stash->{current_model};
 560     }
 561     return $c->model( $c->config->{default_model} )
 562       if $c->config->{default_model};
 563
 564     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
 565
 566     if( $rest ) {
 567         $c->log->warn( 'Calling $c->model() will return a random model unless you specify one of:' );
 568         $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
 569         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 570         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 571         $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
 572     }
 573
 574     return $c->_filter_component( $comp );
 575 }
 576
 577
 578 =head2 $c->view($name)
 579
 580 Gets a L<Catalyst::View> instance by name.
 581
 582     $c->view('Foo')->do_stuff;
 583
 584 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 585
 586 If the name is omitted, it will look for
 587  - a view object in $c->stash->{current_view_instance}, then
 588  - a view name in $c->stash->{current_view}, then
 589  - a config setting 'default_view', or
 590  - check if there is only one view, and return it if that's the case.
 591
 592 If you want to search for views, pass in a regexp as the argument.
 593
 594     # find all views that start with Foo
 595     my @foo_views = $c->view(qr{^Foo});
 596
 597 =cut
 598
 599 sub view {
 600     my ( $c, $name, @args ) = @_;
 601
 602     if( $name ) {
 603         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
 604         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 605         return $c->_filter_component( $result[ 0 ], @args );
 606     }
 607
 608     if (ref $c) {
 609         return $c->stash->{current_view_instance}
 610           if $c->stash->{current_view_instance};
 611         return $c->view( $c->stash->{current_view} )
 612           if $c->stash->{current_view};
 613     }
 614     return $c->view( $c->config->{default_view} )
 615       if $c->config->{default_view};
 616
 617     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
 618
 619     if( $rest ) {
 620         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 621         $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
 622         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 623         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 624         $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
 625     }
 626
 627     return $c->_filter_component( $comp );
 628 }
 629
 630 =head2 $c->controllers
 631
 632 Returns the available names which can be passed to $c->controller
 633
 634 =cut
 635
 636 sub controllers {
 637     my ( $c ) = @_;
 638     return $c->_comp_names(qw/Controller C/);
 639 }
 640
 641 =head2 $c->models
 642
 643 Returns the available names which can be passed to $c->model
 644
 645 =cut
 646
 647 sub models {
 648     my ( $c ) = @_;
 649     return $c->_comp_names(qw/Model M/);
 650 }
 651
 652
 653 =head2 $c->views
 654
 655 Returns the available names which can be passed to $c->view
 656
 657 =cut
 658
 659 sub views {
 660     my ( $c ) = @_;
 661     return $c->_comp_names(qw/View V/);
 662 }
 663
 664 =head2 $c->comp($name)
 665
 666 =head2 $c->component($name)
 667
 668 Gets a component object by name. This method is not recommended,
 669 unless you want to get a specific component by full
 670 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 671 should be used instead.
 672
 673 If C<$name> is a regexp, a list of components matched against the full
 674 component name will be returned.
 675
 676 =cut
 677
 678 sub component {
 679     my ( $c, $name, @args ) = @_;
 680
 681     if( $name ) {
 682         my $comps = $c->components;
 683
 684         if( !ref $name ) {
 685             # is it the exact name?
 686             return $comps->{ $name } if exists $comps->{ $name };
 687
 688             # perhaps we just omitted "MyApp"?
 689             my $composed = ( ref $c || $c ) . "::${name}";
 690             return $comps->{ $composed } if exists $comps->{ $composed };
 691
 692             # search all of the models, views and controllers
 693             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
 694             return $c->_filter_component( $comp, @args ) if $comp;
 695         }
 696
 697         # This is here so $c->comp( '::M::' ) works
 698         my $query = ref $name ? $name : qr{$name}i;
 699
 700         my @result = grep { m{$query} } keys %{ $c->components };
 701         return @result if ref $name;
 702
 703         if( $result[ 0 ] ) {
 704             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 705             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 706             return $result[ 0 ];
 707         }
 708
 709         # I would expect to return an empty list here, but that breaks back-compat
 710     }
 711
 712     # fallback
 713     return sort keys %{ $c->components };
 714 }
 715
 716 =head2 CLASS DATA AND HELPER CLASSES
 717
 718 =head2 $c->config
 719
 720 Returns or takes a hashref containing the application's configuration.
 721
 722     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 723
 724 You can also use a C<YAML>, C<XML> or C<Config::General> config file
 725 like myapp.yml in your applications home directory. See
 726 L<Catalyst::Plugin::ConfigLoader>.
 727
 728     ---
 729     db: dsn:SQLite:foo.db
 730
 731
 732 =cut
 733
 734 sub config {
 735     my $c = shift;
 736
 737     $c->log->warn("Setting config after setup has been run is not a good idea.")
 738       if ( @_ and $c->setup_finished );
 739
 740     $c->NEXT::config(@_);
 741 }
 742
 743 =head2 $c->log
 744
 745 Returns the logging object instance. Unless it is already set, Catalyst
 746 sets this up with a L<Catalyst::Log> object. To use your own log class,
 747 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 748 C<< __PACKAGE__->setup >>.
 749
 750  __PACKAGE__->log( MyLogger->new );
 751  __PACKAGE__->setup;
 752
 753 And later:
 754
 755     $c->log->info( 'Now logging with my own logger!' );
 756
 757 Your log class should implement the methods described in
 758 L<Catalyst::Log>.
 759
 760
 761 =head2 $c->debug
 762
 763 Overload to enable debug messages (same as -Debug option).
 764
 765 Note that this is a static method, not an accessor and should be overloaded
 766 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
 767
 768 =cut
 769
 770 sub debug { 0 }
 771
 772 =head2 $c->dispatcher
 773
 774 Returns the dispatcher instance. Stringifies to class name. See
 775 L<Catalyst::Dispatcher>.
 776
 777 =head2 $c->engine
 778
 779 Returns the engine instance. Stringifies to the class name. See
 780 L<Catalyst::Engine>.
 781
 782
 783 =head2 UTILITY METHODS
 784
 785 =head2 $c->path_to(@path)
 786
 787 Merges C<@path> with C<< $c->config->{home} >> and returns a
 788 L<Path::Class::Dir> object.
 789
 790 For example:
 791
 792     $c->path_to( 'db', 'sqlite.db' );
 793
 794 =cut
 795
 796 sub path_to {
 797     my ( $c, @path ) = @_;
 798     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 799     if ( -d $path ) { return $path }
 800     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 801 }
 802
 803 =head2 $c->plugin( $name, $class, @args )
 804
 805 Helper method for plugins. It creates a classdata accessor/mutator and
 806 loads and instantiates the given class.
 807
 808     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 809
 810     $c->prototype->define_javascript_functions;
 811
 812 =cut
 813
 814 sub plugin {
 815     my ( $class, $name, $plugin, @args ) = @_;
 816     $class->_register_plugin( $plugin, 1 );
 817
 818     eval { $plugin->import };
 819     $class->mk_classdata($name);
 820     my $obj;
 821     eval { $obj = $plugin->new(@args) };
 822
 823     if ($@) {
 824         Catalyst::Exception->throw( message =>
 825               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 826     }
 827
 828     $class->$name($obj);
 829     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 830       if $class->debug;
 831 }
 832
 833 =head2 MyApp->setup
 834
 835 Initializes the dispatcher and engine, loads any plugins, and loads the
 836 model, view, and controller components. You may also specify an array
 837 of plugins to load here, if you choose to not load them in the C<use
 838 Catalyst> line.
 839
 840     MyApp->setup;
 841     MyApp->setup( qw/-Debug/ );
 842
 843 =cut
 844
 845 sub setup {
 846     my ( $class, @arguments ) = @_;
 847
 848     $class->log->warn("Running setup twice is not a good idea.")
 849       if ( $class->setup_finished );
 850
 851     unless ( $class->isa('Catalyst') ) {
 852
 853         Catalyst::Exception->throw(
 854             message => qq/'$class' does not inherit from Catalyst/ );
 855     }
 856
 857     if ( $class->arguments ) {
 858         @arguments = ( @arguments, @{ $class->arguments } );
 859     }
 860
 861     # Process options
 862     my $flags = {};
 863
 864     foreach (@arguments) {
 865
 866         if (/^-Debug$/) {
 867             $flags->{log} =
 868               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 869         }
 870         elsif (/^-(\w+)=?(.*)$/) {
 871             $flags->{ lc $1 } = $2;
 872         }
 873         else {
 874             push @{ $flags->{plugins} }, $_;
 875         }
 876     }
 877
 878     $class->setup_home( delete $flags->{home} );
 879
 880     $class->setup_log( delete $flags->{log} );
 881     $class->setup_plugins( delete $flags->{plugins} );
 882     $class->setup_dispatcher( delete $flags->{dispatcher} );
 883     $class->setup_engine( delete $flags->{engine} );
 884     $class->setup_stats( delete $flags->{stats} );
 885
 886     for my $flag ( sort keys %{$flags} ) {
 887
 888         if ( my $code = $class->can( 'setup_' . $flag ) ) {
 889             &$code( $class, delete $flags->{$flag} );
 890         }
 891         else {
 892             $class->log->warn(qq/Unknown flag "$flag"/);
 893         }
 894     }
 895
 896     eval { require Catalyst::Devel; };
 897     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
 898         $class->log->warn(<<"EOF");
 899 You are running an old script!
 900
 901   Please update by running (this will overwrite existing files):
 902     catalyst.pl -force -scripts $class
 903
 904   or (this will not overwrite existing files):
 905     catalyst.pl -scripts $class
 906
 907 EOF
 908     }
 909
 910     if ( $class->debug ) {
 911         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 912
 913         if (@plugins) {
 914             my $t = Text::SimpleTable->new(74);
 915             $t->row($_) for @plugins;
 916             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
 917         }
 918
 919         my $dispatcher = $class->dispatcher;
 920         my $engine     = $class->engine;
 921         my $home       = $class->config->{home};
 922
 923         $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 924         $class->log->debug(qq/Loaded engine "$engine"/);
 925
 926         $home
 927           ? ( -d $home )
 928           ? $class->log->debug(qq/Found home "$home"/)
 929           : $class->log->debug(qq/Home "$home" doesn't exist/)
 930           : $class->log->debug(q/Couldn't find home/);
 931     }
 932
 933     # Call plugins setup
 934     {
 935         no warnings qw/redefine/;
 936         local *setup = sub { };
 937         $class->setup;
 938     }
 939
 940     # Initialize our data structure
 941     $class->components( {} );
 942
 943     $class->setup_components;
 944
 945     if ( $class->debug ) {
 946         my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
 947         for my $comp ( sort keys %{ $class->components } ) {
 948             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
 949             $t->row( $comp, $type );
 950         }
 951         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
 952           if ( keys %{ $class->components } );
 953     }
 954
 955     # Add our self to components, since we are also a component
 956     $class->components->{$class} = $class;
 957
 958     $class->setup_actions;
 959
 960     if ( $class->debug ) {
 961         my $name = $class->config->{name} || 'Application';
 962         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 963     }
 964     $class->log->_flush() if $class->log->can('_flush');
 965
 966     $class->setup_finished(1);
 967 }
 968
 969 =head2 $c->uri_for( $path, @args?, \%query_values? )
 970
 971 Merges path with C<< $c->request->base >> for absolute URIs and with
 972 C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
 973 object. If any args are passed, they are added at the end of the path.
 974 If the last argument to C<uri_for> is a hash reference, it is assumed to
 975 contain GET parameter key/value pairs, which will be appended to the URI
 976 in standard fashion.
 977
 978 Note that uri_for is destructive to the passed hashref.  Subsequent calls
 979 with the same hashref may have unintended results.
 980
 981 Instead of C<$path>, you can also optionally pass a C<$action> object
 982 which will be resolved to a path using
 983 C<< $c->dispatcher->uri_for_action >>; if the first element of
 984 C<@args> is an arrayref it is treated as a list of captures to be passed
 985 to C<uri_for_action>.
 986
 987 =cut
 988
 989 sub uri_for {
 990     my ( $c, $path, @args ) = @_;
 991
 992     if ( Scalar::Util::blessed($path) ) { # action object
 993         my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
 994                          ? shift(@args)
 995                          : [] );
 996         $path = $c->dispatcher->uri_for_action($path, $captures);
 997         return undef unless defined($path);
 998         $path = '/' if $path eq '';
 999     }
1000
1001     undef($path) if (defined $path && $path eq '');
1002
1003     my $params =
1004       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1005
1006     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1007     s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1008
1009     unshift(@args, $path);
1010
1011     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1012         my $namespace = $c->namespace;
1013         if (defined $path) { # cheesy hack to handle path '../foo'
1014            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1015         }
1016         unshift(@args, $namespace || '');
1017     }
1018
1019     # join args with '/', or a blank string
1020     my $args = join('/', grep { defined($_) } @args);
1021     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1022     $args =~ s!^/!!;
1023     my $base = $c->req->base;
1024     my $class = ref($base);
1025     $base =~ s{(?<!/)$}{/};
1026
1027     my $query = '';
1028
1029     if (my @keys = keys %$params) {
1030       # somewhat lifted from URI::_query's query_form
1031       $query = '?'.join('&', map {
1032           my $val = $params->{$_};
1033           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1034           s/ /+/g;
1035           my $key = $_;
1036           $val = '' unless defined $val;
1037           (map {
1038               $_ = "$_";
1039               utf8::encode( $_ ) if utf8::is_utf8($_);
1040               # using the URI::Escape pattern here so utf8 chars survive
1041               s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1042               s/ /+/g;
1043               "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1044       } @keys);
1045     }
1046
1047     my $res = bless(\"${base}${args}${query}", $class);
1048     $res;
1049 }
1050
1051 =head2 $c->welcome_message
1052
1053 Returns the Catalyst welcome HTML page.
1054
1055 =cut
1056
1057 sub welcome_message {
1058     my $c      = shift;
1059     my $name   = $c->config->{name};
1060     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1061     my $prefix = Catalyst::Utils::appprefix( ref $c );
1062     $c->response->content_type('text/html; charset=utf-8');
1063     return <<"EOF";
1064 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1065     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1066 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1067     <head>
1068     <meta http-equiv="Content-Language" content="en" />
1069     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1070         <title>$name on Catalyst $VERSION</title>
1071         <style type="text/css">
1072             body {
1073                 color: #000;
1074                 background-color: #eee;
1075             }
1076             div#content {
1077                 width: 640px;
1078                 margin-left: auto;
1079                 margin-right: auto;
1080                 margin-top: 10px;
1081                 margin-bottom: 10px;
1082                 text-align: left;
1083                 background-color: #ccc;
1084                 border: 1px solid #aaa;
1085             }
1086             p, h1, h2 {
1087                 margin-left: 20px;
1088                 margin-right: 20px;
1089                 font-family: verdana, tahoma, sans-serif;
1090             }
1091             a {
1092                 font-family: verdana, tahoma, sans-serif;
1093             }
1094             :link, :visited {
1095                     text-decoration: none;
1096                     color: #b00;
1097                     border-bottom: 1px dotted #bbb;
1098             }
1099             :link:hover, :visited:hover {
1100                     color: #555;
1101             }
1102             div#topbar {
1103                 margin: 0px;
1104             }
1105             pre {
1106                 margin: 10px;
1107                 padding: 8px;
1108             }
1109             div#answers {
1110                 padding: 8px;
1111                 margin: 10px;
1112                 background-color: #fff;
1113                 border: 1px solid #aaa;
1114             }
1115             h1 {
1116                 font-size: 0.9em;
1117                 font-weight: normal;
1118                 text-align: center;
1119             }
1120             h2 {
1121                 font-size: 1.0em;
1122             }
1123             p {
1124                 font-size: 0.9em;
1125             }
1126             p img {
1127                 float: right;
1128                 margin-left: 10px;
1129             }
1130             span#appname {
1131                 font-weight: bold;
1132                 font-size: 1.6em;
1133             }
1134         </style>
1135     </head>
1136     <body>
1137         <div id="content">
1138             <div id="topbar">
1139                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1140                     $VERSION</h1>
1141              </div>
1142              <div id="answers">
1143                  <p>
1144                  <img src="$logo" alt="Catalyst Logo" />
1145                  </p>
1146                  <p>Welcome to the  world of Catalyst.
1147                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1148                     framework will make web development something you had
1149                     never expected it to be: Fun, rewarding, and quick.</p>
1150                  <h2>What to do now?</h2>
1151                  <p>That really depends  on what <b>you</b> want to do.
1152                     We do, however, provide you with a few starting points.</p>
1153                  <p>If you want to jump right into web development with Catalyst
1154                     you might want to start with a tutorial.</p>
1155 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1156 </pre>
1157 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1158 <pre>
1159 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1160 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1161 </code></pre>
1162                  <h2>What to do next?</h2>
1163                  <p>Next it's time to write an actual application. Use the
1164                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1165                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1166                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1167                     they can save you a lot of work.</p>
1168                     <pre><code>script/${prefix}_create.pl -help</code></pre>
1169                     <p>Also, be sure to check out the vast and growing
1170                     collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
1171                     you are likely to find what you need there.
1172                     </p>
1173
1174                  <h2>Need help?</h2>
1175                  <p>Catalyst has a very active community. Here are the main places to
1176                     get in touch with us.</p>
1177                  <ul>
1178                      <li>
1179                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1180                      </li>
1181                      <li>
1182                          <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
1183                      </li>
1184                      <li>
1185                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1186                      </li>
1187                  </ul>
1188                  <h2>In conclusion</h2>
1189                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1190                     as we enjoyed making it. Please contact us if you have ideas
1191                     for improvement or other feedback.</p>
1192              </div>
1193          </div>
1194     </body>
1195 </html>
1196 EOF
1197 }
1198
1199 =head1 INTERNAL METHODS
1200
1201 These methods are not meant to be used by end users.
1202
1203 =head2 $c->components
1204
1205 Returns a hash of components.
1206
1207 =head2 $c->context_class
1208
1209 Returns or sets the context class.
1210
1211 =head2 $c->counter
1212
1213 Returns a hashref containing coderefs and execution counts (needed for
1214 deep recursion detection).
1215
1216 =head2 $c->depth
1217
1218 Returns the number of actions on the current internal execution stack.
1219
1220 =head2 $c->dispatch
1221
1222 Dispatches a request to actions.
1223
1224 =cut
1225
1226 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1227
1228 =head2 $c->dispatcher_class
1229
1230 Returns or sets the dispatcher class.
1231
1232 =head2 $c->dump_these
1233
1234 Returns a list of 2-element array references (name, structure) pairs
1235 that will be dumped on the error page in debug mode.
1236
1237 =cut
1238
1239 sub dump_these {
1240     my $c = shift;
1241     [ Request => $c->req ],
1242     [ Response => $c->res ],
1243     [ Stash => $c->stash ],
1244     [ Config => $c->config ];
1245 }
1246
1247 =head2 $c->engine_class
1248
1249 Returns or sets the engine class.
1250
1251 =head2 $c->execute( $class, $coderef )
1252
1253 Execute a coderef in given class and catch exceptions. Errors are available
1254 via $c->error.
1255
1256 =cut
1257
1258 sub execute {
1259     my ( $c, $class, $code ) = @_;
1260     $class = $c->component($class) || $class;
1261     $c->state(0);
1262
1263     if ( $c->depth >= $RECURSION ) {
1264         my $action = "$code";
1265         $action = "/$action" unless $action =~ /->/;
1266         my $error = qq/Deep recursion detected calling "$action"/;
1267         $c->log->error($error);
1268         $c->error($error);
1269         $c->state(0);
1270         return $c->state;
1271     }
1272
1273     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1274
1275     push( @{ $c->stack }, $code );
1276
1277     eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
1278
1279     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1280
1281     my $last = pop( @{ $c->stack } );
1282
1283     if ( my $error = $@ ) {
1284         if ( !ref($error) and $error eq $DETACH ) {
1285             die $DETACH if($c->depth > 1);
1286         }
1287         elsif ( !ref($error) and $error eq $GO ) {
1288             die $GO if($c->depth > 0);
1289         }
1290         else {
1291             unless ( ref $error ) {
1292                 no warnings 'uninitialized';
1293                 chomp $error;
1294                 my $class = $last->class;
1295                 my $name  = $last->name;
1296                 $error = qq/Caught exception in $class->$name "$error"/;
1297             }
1298             $c->error($error);
1299             $c->state(0);
1300         }
1301     }
1302     return $c->state;
1303 }
1304
1305 sub _stats_start_execute {
1306     my ( $c, $code ) = @_;
1307
1308     return if ( ( $code->name =~ /^_.*/ )
1309         && ( !$c->config->{show_internal_actions} ) );
1310
1311     $c->counter->{"$code"}++;
1312
1313     my $action = "$code";
1314     $action = "/$action" unless $action =~ /->/;
1315
1316     # determine if the call was the result of a forward
1317     # this is done by walking up the call stack and looking for a calling
1318     # sub of Catalyst::forward before the eval
1319     my $callsub = q{};
1320     for my $index ( 2 .. 11 ) {
1321         last
1322         if ( ( caller($index) )[0] eq 'Catalyst'
1323             && ( caller($index) )[3] eq '(eval)' );
1324
1325         if ( ( caller($index) )[3] =~ /forward$/ ) {
1326             $callsub = ( caller($index) )[3];
1327             $action  = "-> $action";
1328             last;
1329         }
1330     }
1331
1332     my $uid = "$code" . $c->counter->{"$code"};
1333
1334     # is this a root-level call or a forwarded call?
1335     if ( $callsub =~ /forward$/ ) {
1336
1337         # forward, locate the caller
1338         if ( my $parent = $c->stack->[-1] ) {
1339             $c->stats->profile(
1340                 begin  => $action,
1341                 parent => "$parent" . $c->counter->{"$parent"},
1342                 uid    => $uid,
1343             );
1344         }
1345         else {
1346
1347             # forward with no caller may come from a plugin
1348             $c->stats->profile(
1349                 begin => $action,
1350                 uid   => $uid,
1351             );
1352         }
1353     }
1354     else {
1355
1356         # root-level call
1357         $c->stats->profile(
1358             begin => $action,
1359             uid   => $uid,
1360         );
1361     }
1362     return $action;
1363
1364 }
1365
1366 sub _stats_finish_execute {
1367     my ( $c, $info ) = @_;
1368     $c->stats->profile( end => $info );
1369 }
1370
1371 =head2 $c->_localize_fields( sub { }, \%keys );
1372
1373 =cut
1374
1375 sub _localize_fields {
1376     my ( $c, $localized, $code ) = ( @_ );
1377
1378     my $request = delete $localized->{request} || {};
1379     my $response = delete $localized->{response} || {};
1380
1381     local @{ $c }{ keys %$localized } = values %$localized;
1382     local @{ $c->request }{ keys %$request } = values %$request;
1383     local @{ $c->response }{ keys %$response } = values %$response;
1384
1385     $code->();
1386 }
1387
1388 =head2 $c->finalize
1389
1390 Finalizes the request.
1391
1392 =cut
1393
1394 sub finalize {
1395     my $c = shift;
1396
1397     for my $error ( @{ $c->error } ) {
1398         $c->log->error($error);
1399     }
1400
1401     # Allow engine to handle finalize flow (for POE)
1402     if ( $c->engine->can('finalize') ) {
1403         $c->engine->finalize($c);
1404     }
1405     else {
1406
1407         $c->finalize_uploads;
1408
1409         # Error
1410         if ( $#{ $c->error } >= 0 ) {
1411             $c->finalize_error;
1412         }
1413
1414         $c->finalize_headers;
1415
1416         # HEAD request
1417         if ( $c->request->method eq 'HEAD' ) {
1418             $c->response->body('');
1419         }
1420
1421         $c->finalize_body;
1422     }
1423
1424     if ($c->use_stats) {
1425         my $elapsed = sprintf '%f', $c->stats->elapsed;
1426         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1427         $c->log->info(
1428             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1429     }
1430
1431     return $c->response->status;
1432 }
1433
1434 =head2 $c->finalize_body
1435
1436 Finalizes body.
1437
1438 =cut
1439
1440 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1441
1442 =head2 $c->finalize_cookies
1443
1444 Finalizes cookies.
1445
1446 =cut
1447
1448 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1449
1450 =head2 $c->finalize_error
1451
1452 Finalizes error.
1453
1454 =cut
1455
1456 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1457
1458 =head2 $c->finalize_headers
1459
1460 Finalizes headers.
1461
1462 =cut
1463
1464 sub finalize_headers {
1465     my $c = shift;
1466
1467     # Check if we already finalized headers
1468     return if $c->response->{_finalized_headers};
1469
1470     # Handle redirects
1471     if ( my $location = $c->response->redirect ) {
1472         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1473         $c->response->header( Location => $location );
1474
1475         if ( !$c->response->body ) {
1476             # Add a default body if none is already present
1477             $c->response->body(
1478                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1479             );
1480         }
1481     }
1482
1483     # Content-Length
1484     if ( $c->response->body && !$c->response->content_length ) {
1485
1486         # get the length from a filehandle
1487         if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1488         {
1489             my $stat = stat $c->response->body;
1490             if ( $stat && $stat->size > 0 ) {
1491                 $c->response->content_length( $stat->size );
1492             }
1493             else {
1494                 $c->log->warn('Serving filehandle without a content-length');
1495             }
1496         }
1497         else {
1498             # everything should be bytes at this point, but just in case
1499             $c->response->content_length( bytes::length( $c->response->body ) );
1500         }
1501     }
1502
1503     # Errors
1504     if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1505         $c->response->headers->remove_header("Content-Length");
1506         $c->response->body('');
1507     }
1508
1509     $c->finalize_cookies;
1510
1511     $c->engine->finalize_headers( $c, @_ );
1512
1513     # Done
1514     $c->response->{_finalized_headers} = 1;
1515 }
1516
1517 =head2 $c->finalize_output
1518
1519 An alias for finalize_body.
1520
1521 =head2 $c->finalize_read
1522
1523 Finalizes the input after reading is complete.
1524
1525 =cut
1526
1527 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1528
1529 =head2 $c->finalize_uploads
1530
1531 Finalizes uploads. Cleans up any temporary files.
1532
1533 =cut
1534
1535 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1536
1537 =head2 $c->get_action( $action, $namespace )
1538
1539 Gets an action in a given namespace.
1540
1541 =cut
1542
1543 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1544
1545 =head2 $c->get_actions( $action, $namespace )
1546
1547 Gets all actions of a given name in a namespace and all parent
1548 namespaces.
1549
1550 =cut
1551
1552 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1553
1554 =head2 $c->handle_request( $class, @arguments )
1555
1556 Called to handle each HTTP request.
1557
1558 =cut
1559
1560 sub handle_request {
1561     my ( $class, @arguments ) = @_;
1562
1563     # Always expect worst case!
1564     my $status = -1;
1565     eval {
1566         if ($class->debug) {
1567             my $secs = time - $START || 1;
1568             my $av = sprintf '%.3f', $COUNT / $secs;
1569             my $time = localtime time;
1570             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1571         }
1572
1573         my $c = $class->prepare(@arguments);
1574         $c->dispatch;
1575         $status = $c->finalize;
1576     };
1577
1578     if ( my $error = $@ ) {
1579         chomp $error;
1580         $class->log->error(qq/Caught exception in engine "$error"/);
1581     }
1582
1583     $COUNT++;
1584     $class->log->_flush() if $class->log->can('_flush');
1585     return $status;
1586 }
1587
1588 =head2 $c->prepare( @arguments )
1589
1590 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1591 etc.).
1592
1593 =cut
1594
1595 sub prepare {
1596     my ( $class, @arguments ) = @_;
1597
1598     $class->context_class( ref $class || $class ) unless $class->context_class;
1599     my $c = $class->context_class->new(
1600         {
1601             counter => {},
1602             stack   => [],
1603             request => $class->request_class->new(
1604                 {
1605                     arguments        => [],
1606                     body_parameters  => {},
1607                     cookies          => {},
1608                     headers          => HTTP::Headers->new,
1609                     parameters       => {},
1610                     query_parameters => {},
1611                     secure           => 0,
1612                     captures         => [],
1613                     uploads          => {}
1614                 }
1615             ),
1616             response => $class->response_class->new(
1617                 {
1618                     body    => '',
1619                     cookies => {},
1620                     headers => HTTP::Headers->new(),
1621                     status  => 200
1622                 }
1623             ),
1624             stash => {},
1625             state => 0
1626         }
1627     );
1628
1629     $c->stats($class->stats_class->new)->enable($c->use_stats);
1630     if ( $c->debug ) {
1631         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1632     }
1633
1634     # For on-demand data
1635     $c->request->{_context}  = $c;
1636     $c->response->{_context} = $c;
1637     weaken( $c->request->{_context} );
1638     weaken( $c->response->{_context} );
1639
1640     # Allow engine to direct the prepare flow (for POE)
1641     if ( $c->engine->can('prepare') ) {
1642         $c->engine->prepare( $c, @arguments );
1643     }
1644     else {
1645         $c->prepare_request(@arguments);
1646         $c->prepare_connection;
1647         $c->prepare_query_parameters;
1648         $c->prepare_headers;
1649         $c->prepare_cookies;
1650         $c->prepare_path;
1651
1652         # Prepare the body for reading, either by prepare_body
1653         # or the user, if they are using $c->read
1654         $c->prepare_read;
1655
1656         # Parse the body unless the user wants it on-demand
1657         unless ( $c->config->{parse_on_demand} ) {
1658             $c->prepare_body;
1659         }
1660     }
1661
1662     my $method  = $c->req->method  || '';
1663     my $path    = $c->req->path;
1664     $path       = '/' unless length $path;
1665     my $address = $c->req->address || '';
1666
1667     $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1668       if $c->debug;
1669
1670     $c->prepare_action;
1671
1672     return $c;
1673 }
1674
1675 =head2 $c->prepare_action
1676
1677 Prepares action. See L<Catalyst::Dispatcher>.
1678
1679 =cut
1680
1681 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1682
1683 =head2 $c->prepare_body
1684
1685 Prepares message body.
1686
1687 =cut
1688
1689 sub prepare_body {
1690     my $c = shift;
1691
1692     # Do we run for the first time?
1693     return if defined $c->request->{_body};
1694
1695     # Initialize on-demand data
1696     $c->engine->prepare_body( $c, @_ );
1697     $c->prepare_parameters;
1698     $c->prepare_uploads;
1699
1700     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1701         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1702         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1703             my $param = $c->req->body_parameters->{$key};
1704             my $value = defined($param) ? $param : '';
1705             $t->row( $key,
1706                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1707         }
1708         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1709     }
1710 }
1711
1712 =head2 $c->prepare_body_chunk( $chunk )
1713
1714 Prepares a chunk of data before sending it to L<HTTP::Body>.
1715
1716 See L<Catalyst::Engine>.
1717
1718 =cut
1719
1720 sub prepare_body_chunk {
1721     my $c = shift;
1722     $c->engine->prepare_body_chunk( $c, @_ );
1723 }
1724
1725 =head2 $c->prepare_body_parameters
1726
1727 Prepares body parameters.
1728
1729 =cut
1730
1731 sub prepare_body_parameters {
1732     my $c = shift;
1733     $c->engine->prepare_body_parameters( $c, @_ );
1734 }
1735
1736 =head2 $c->prepare_connection
1737
1738 Prepares connection.
1739
1740 =cut
1741
1742 sub prepare_connection {
1743     my $c = shift;
1744     $c->engine->prepare_connection( $c, @_ );
1745 }
1746
1747 =head2 $c->prepare_cookies
1748
1749 Prepares cookies.
1750
1751 =cut
1752
1753 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1754
1755 =head2 $c->prepare_headers
1756
1757 Prepares headers.
1758
1759 =cut
1760
1761 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1762
1763 =head2 $c->prepare_parameters
1764
1765 Prepares parameters.
1766
1767 =cut
1768
1769 sub prepare_parameters {
1770     my $c = shift;
1771     $c->prepare_body_parameters;
1772     $c->engine->prepare_parameters( $c, @_ );
1773 }
1774
1775 =head2 $c->prepare_path
1776
1777 Prepares path and base.
1778
1779 =cut
1780
1781 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1782
1783 =head2 $c->prepare_query_parameters
1784
1785 Prepares query parameters.
1786
1787 =cut
1788
1789 sub prepare_query_parameters {
1790     my $c = shift;
1791
1792     $c->engine->prepare_query_parameters( $c, @_ );
1793
1794     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1795         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1796         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1797             my $param = $c->req->query_parameters->{$key};
1798             my $value = defined($param) ? $param : '';
1799             $t->row( $key,
1800                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1801         }
1802         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1803     }
1804 }
1805
1806 =head2 $c->prepare_read
1807
1808 Prepares the input for reading.
1809
1810 =cut
1811
1812 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1813
1814 =head2 $c->prepare_request
1815
1816 Prepares the engine request.
1817
1818 =cut
1819
1820 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1821
1822 =head2 $c->prepare_uploads
1823
1824 Prepares uploads.
1825
1826 =cut
1827
1828 sub prepare_uploads {
1829     my $c = shift;
1830
1831     $c->engine->prepare_uploads( $c, @_ );
1832
1833     if ( $c->debug && keys %{ $c->request->uploads } ) {
1834         my $t = Text::SimpleTable->new(
1835             [ 12, 'Parameter' ],
1836             [ 26, 'Filename' ],
1837             [ 18, 'Type' ],
1838             [ 9,  'Size' ]
1839         );
1840         for my $key ( sort keys %{ $c->request->uploads } ) {
1841             my $upload = $c->request->uploads->{$key};
1842             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1843                 $t->row( $key, $u->filename, $u->type, $u->size );
1844             }
1845         }
1846         $c->log->debug( "File Uploads are:\n" . $t->draw );
1847     }
1848 }
1849
1850 =head2 $c->prepare_write
1851
1852 Prepares the output for writing.
1853
1854 =cut
1855
1856 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1857
1858 =head2 $c->request_class
1859
1860 Returns or sets the request class.
1861
1862 =head2 $c->response_class
1863
1864 Returns or sets the response class.
1865
1866 =head2 $c->read( [$maxlength] )
1867
1868 Reads a chunk of data from the request body. This method is designed to
1869 be used in a while loop, reading C<$maxlength> bytes on every call.
1870 C<$maxlength> defaults to the size of the request if not specified.
1871
1872 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1873 directly.
1874
1875 Warning: If you use read(), Catalyst will not process the body,
1876 so you will not be able to access POST parameters or file uploads via
1877 $c->request.  You must handle all body parsing yourself.
1878
1879 =cut
1880
1881 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1882
1883 =head2 $c->run
1884
1885 Starts the engine.
1886
1887 =cut
1888
1889 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1890
1891 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1892
1893 Sets an action in a given namespace.
1894
1895 =cut
1896
1897 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1898
1899 =head2 $c->setup_actions($component)
1900
1901 Sets up actions for a component.
1902
1903 =cut
1904
1905 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1906
1907 =head2 $c->setup_components
1908
1909 Sets up components. Specify a C<setup_components> config option to pass
1910 additional options directly to L<Module::Pluggable>. To add additional
1911 search paths, specify a key named C<search_extra> as an array
1912 reference. Items in the array beginning with C<::> will have the
1913 application class name prepended to them.
1914
1915 All components found will also have any
1916 L<Devel::InnerPackage|inner packages> loaded and set up as components.
1917 Note, that modules which are B<not> an I<inner package> of the main
1918 file namespace loaded will not be instantiated as components.
1919
1920 =cut
1921
1922 sub setup_components {
1923     my $class = shift;
1924
1925     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
1926     my $config  = $class->config->{ setup_components };
1927     my $extra   = delete $config->{ search_extra } || [];
1928
1929     push @paths, @$extra;
1930
1931     my $locator = Module::Pluggable::Object->new(
1932         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1933         %$config
1934     );
1935
1936     my @comps = sort { length $a <=> length $b } $locator->plugins;
1937     my %comps = map { $_ => 1 } @comps;
1938
1939     for my $component ( @comps ) {
1940
1941         # We pass ignore_loaded here so that overlay files for (e.g.)
1942         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
1943         # we know M::P::O found a file on disk so this is safe
1944
1945         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1946
1947         my $module  = $class->setup_component( $component );
1948         my %modules = (
1949             $component => $module,
1950             map {
1951                 $_ => $class->setup_component( $_ )
1952             } grep {
1953               not exists $comps{$_}
1954             } Devel::InnerPackage::list_packages( $component )
1955         );
1956
1957         for my $key ( keys %modules ) {
1958             $class->components->{ $key } = $modules{ $key };
1959         }
1960     }
1961 }
1962
1963 =head2 $c->setup_component
1964
1965 =cut
1966
1967 sub setup_component {
1968     my( $class, $component ) = @_;
1969
1970     unless ( $component->can( 'COMPONENT' ) ) {
1971         return $component;
1972     }
1973
1974     my $suffix = Catalyst::Utils::class2classsuffix( $component );
1975     my $config = $class->config->{ $suffix } || {};
1976
1977     my $instance = eval { $component->COMPONENT( $class, $config ); };
1978
1979     if ( my $error = $@ ) {
1980         chomp $error;
1981         Catalyst::Exception->throw(
1982             message => qq/Couldn't instantiate component "$component", "$error"/
1983         );
1984     }
1985
1986     Catalyst::Exception->throw(
1987         message =>
1988         qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
1989     ) unless eval { $instance->can( 'can' ) };
1990
1991     return $instance;
1992 }
1993
1994 =head2 $c->setup_dispatcher
1995
1996 Sets up dispatcher.
1997
1998 =cut
1999
2000 sub setup_dispatcher {
2001     my ( $class, $dispatcher ) = @_;
2002
2003     if ($dispatcher) {
2004         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2005     }
2006
2007     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2008         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2009     }
2010
2011     unless ($dispatcher) {
2012         $dispatcher = $class->dispatcher_class;
2013     }
2014
2015     unless (Class::Inspector->loaded($dispatcher)) {
2016         require Class::Inspector->filename($dispatcher);
2017     }
2018
2019     # dispatcher instance
2020     $class->dispatcher( $dispatcher->new );
2021 }
2022
2023 =head2 $c->setup_engine
2024
2025 Sets up engine.
2026
2027 =cut
2028
2029 sub setup_engine {
2030     my ( $class, $engine ) = @_;
2031
2032     if ($engine) {
2033         $engine = 'Catalyst::Engine::' . $engine;
2034     }
2035
2036     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2037         $engine = 'Catalyst::Engine::' . $env;
2038     }
2039
2040     if ( $ENV{MOD_PERL} ) {
2041
2042         # create the apache method
2043         {
2044             no strict 'refs';
2045             *{"$class\::apache"} = sub { shift->engine->apache };
2046         }
2047
2048         my ( $software, $version ) =
2049           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2050
2051         $version =~ s/_//g;
2052         $version =~ s/(\.[^.]+)\./$1/g;
2053
2054         if ( $software eq 'mod_perl' ) {
2055
2056             if ( !$engine ) {
2057
2058                 if ( $version >= 1.99922 ) {
2059                     $engine = 'Catalyst::Engine::Apache2::MP20';
2060                 }
2061
2062                 elsif ( $version >= 1.9901 ) {
2063                     $engine = 'Catalyst::Engine::Apache2::MP19';
2064                 }
2065
2066                 elsif ( $version >= 1.24 ) {
2067                     $engine = 'Catalyst::Engine::Apache::MP13';
2068                 }
2069
2070                 else {
2071                     Catalyst::Exception->throw( message =>
2072                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2073                 }
2074
2075             }
2076
2077             # install the correct mod_perl handler
2078             if ( $version >= 1.9901 ) {
2079                 *handler = sub  : method {
2080                     shift->handle_request(@_);
2081                 };
2082             }
2083             else {
2084                 *handler = sub ($$) { shift->handle_request(@_) };
2085             }
2086
2087         }
2088
2089         elsif ( $software eq 'Zeus-Perl' ) {
2090             $engine = 'Catalyst::Engine::Zeus';
2091         }
2092
2093         else {
2094             Catalyst::Exception->throw(
2095                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2096         }
2097     }
2098
2099     unless ($engine) {
2100         $engine = $class->engine_class;
2101     }
2102
2103     unless (Class::Inspector->loaded($engine)) {
2104         require Class::Inspector->filename($engine);
2105     }
2106
2107     # check for old engines that are no longer compatible
2108     my $old_engine;
2109     if ( $engine->isa('Catalyst::Engine::Apache')
2110         && !Catalyst::Engine::Apache->VERSION )
2111     {
2112         $old_engine = 1;
2113     }
2114
2115     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2116         && Catalyst::Engine::Server->VERSION le '0.02' )
2117     {
2118         $old_engine = 1;
2119     }
2120
2121     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2122         && $engine->VERSION eq '0.01' )
2123     {
2124         $old_engine = 1;
2125     }
2126
2127     elsif ($engine->isa('Catalyst::Engine::Zeus')
2128         && $engine->VERSION eq '0.01' )
2129     {
2130         $old_engine = 1;
2131     }
2132
2133     if ($old_engine) {
2134         Catalyst::Exception->throw( message =>
2135               qq/Engine "$engine" is not supported by this version of Catalyst/
2136         );
2137     }
2138
2139     # engine instance
2140     $class->engine( $engine->new );
2141 }
2142
2143 =head2 $c->setup_home
2144
2145 Sets up the home directory.
2146
2147 =cut
2148
2149 sub setup_home {
2150     my ( $class, $home ) = @_;
2151
2152     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2153         $home = $env;
2154     }
2155
2156     unless ($home) {
2157         $home = Catalyst::Utils::home($class);
2158     }
2159
2160     if ($home) {
2161         $class->config->{home} ||= $home;
2162         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2163     }
2164 }
2165
2166 =head2 $c->setup_log
2167
2168 Sets up log.
2169
2170 =cut
2171
2172 sub setup_log {
2173     my ( $class, $debug ) = @_;
2174
2175     unless ( $class->log ) {
2176         $class->log( Catalyst::Log->new );
2177     }
2178
2179     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2180     if ( defined($env_debug) ? $env_debug : $debug ) {
2181         no strict 'refs';
2182         *{"$class\::debug"} = sub { 1 };
2183         $class->log->debug('Debug messages enabled');
2184     }
2185 }
2186
2187 =head2 $c->setup_plugins
2188
2189 Sets up plugins.
2190
2191 =cut
2192
2193 =head2 $c->setup_stats
2194
2195 Sets up timing statistics class.
2196
2197 =cut
2198
2199 sub setup_stats {
2200     my ( $class, $stats ) = @_;
2201
2202     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2203
2204     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2205     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2206         no strict 'refs';
2207         *{"$class\::use_stats"} = sub { 1 };
2208         $class->log->debug('Statistics enabled');
2209     }
2210 }
2211
2212
2213 =head2 $c->registered_plugins
2214
2215 Returns a sorted list of the plugins which have either been stated in the
2216 import list or which have been added via C<< MyApp->plugin(@args); >>.
2217
2218 If passed a given plugin name, it will report a boolean value indicating
2219 whether or not that plugin is loaded.  A fully qualified name is required if
2220 the plugin name does not begin with C<Catalyst::Plugin::>.
2221
2222  if ($c->registered_plugins('Some::Plugin')) {
2223      ...
2224  }
2225
2226 =cut
2227
2228 {
2229
2230     sub registered_plugins {
2231         my $proto = shift;
2232         return sort keys %{ $proto->_plugins } unless @_;
2233         my $plugin = shift;
2234         return 1 if exists $proto->_plugins->{$plugin};
2235         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2236     }
2237
2238     sub _register_plugin {
2239         my ( $proto, $plugin, $instant ) = @_;
2240         my $class = ref $proto || $proto;
2241
2242         # no ignore_loaded here, the plugin may already have been
2243         # defined in memory and we don't want to error on "no file" if so
2244
2245         Catalyst::Utils::ensure_class_loaded( $plugin );
2246
2247         $proto->_plugins->{$plugin} = 1;
2248         unless ($instant) {
2249             no strict 'refs';
2250             unshift @{"$class\::ISA"}, $plugin;
2251         }
2252         return $class;
2253     }
2254
2255     sub setup_plugins {
2256         my ( $class, $plugins ) = @_;
2257
2258         $class->_plugins( {} ) unless $class->_plugins;
2259         $plugins ||= [];
2260         for my $plugin ( reverse @$plugins ) {
2261
2262             unless ( $plugin =~ s/\A\+// ) {
2263                 $plugin = "Catalyst::Plugin::$plugin";
2264             }
2265
2266             $class->_register_plugin($plugin);
2267         }
2268     }
2269 }
2270
2271 =head2 $c->stack
2272
2273 Returns an arrayref of the internal execution stack (actions that are
2274 currently executing).
2275
2276 =head2 $c->stats_class
2277
2278 Returns or sets the stats (timing statistics) class.
2279
2280 =head2 $c->use_stats
2281
2282 Returns 1 when stats collection is enabled.  Stats collection is enabled
2283 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2284 environment variable is set.
2285
2286 Note that this is a static method, not an accessor and should be overloaded
2287 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2288
2289 =cut
2290
2291 sub use_stats { 0 }
2292
2293
2294 =head2 $c->write( $data )
2295
2296 Writes $data to the output stream. When using this method directly, you
2297 will need to manually set the C<Content-Length> header to the length of
2298 your output data, if known.
2299
2300 =cut
2301
2302 sub write {
2303     my $c = shift;
2304
2305     # Finalize headers if someone manually writes output
2306     $c->finalize_headers;
2307
2308     return $c->engine->write( $c, @_ );
2309 }
2310
2311 =head2 version
2312
2313 Returns the Catalyst version number. Mostly useful for "powered by"
2314 messages in template systems.
2315
2316 =cut
2317
2318 sub version { return $Catalyst::VERSION }
2319
2320 =head1 INTERNAL ACTIONS
2321
2322 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2323 C<_ACTION>, and C<_END>. These are by default not shown in the private
2324 action table, but you can make them visible with a config parameter.
2325
2326     MyApp->config->{show_internal_actions} = 1;
2327
2328 =head1 CASE SENSITIVITY
2329
2330 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2331 mapped to C</foo/bar>. You can activate case sensitivity with a config
2332 parameter.
2333
2334     MyApp->config->{case_sensitive} = 1;
2335
2336 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2337
2338 =head1 ON-DEMAND PARSER
2339
2340 The request body is usually parsed at the beginning of a request,
2341 but if you want to handle input yourself, you can enable on-demand
2342 parsing with a config parameter.
2343
2344     MyApp->config->{parse_on_demand} = 1;
2345
2346 =head1 PROXY SUPPORT
2347
2348 Many production servers operate using the common double-server approach,
2349 with a lightweight frontend web server passing requests to a larger
2350 backend server. An application running on the backend server must deal
2351 with two problems: the remote user always appears to be C<127.0.0.1> and
2352 the server's hostname will appear to be C<localhost> regardless of the
2353 virtual host that the user connected through.
2354
2355 Catalyst will automatically detect this situation when you are running
2356 the frontend and backend servers on the same machine. The following
2357 changes are made to the request.
2358
2359     $c->req->address is set to the user's real IP address, as read from
2360     the HTTP X-Forwarded-For header.
2361
2362     The host value for $c->req->base and $c->req->uri is set to the real
2363     host, as read from the HTTP X-Forwarded-Host header.
2364
2365 Obviously, your web server must support these headers for this to work.
2366
2367 In a more complex server farm environment where you may have your
2368 frontend proxy server(s) on different machines, you will need to set a
2369 configuration option to tell Catalyst to read the proxied data from the
2370 headers.
2371
2372     MyApp->config->{using_frontend_proxy} = 1;
2373
2374 If you do not wish to use the proxy support at all, you may set:
2375
2376     MyApp->config->{ignore_frontend_proxy} = 1;
2377
2378 =head1 THREAD SAFETY
2379
2380 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2381 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2382 believe the Catalyst core to be thread-safe.
2383
2384 If you plan to operate in a threaded environment, remember that all other
2385 modules you are using must also be thread-safe. Some modules, most notably
2386 L<DBD::SQLite>, are not thread-safe.
2387
2388 =head1 SUPPORT
2389
2390 IRC:
2391
2392     Join #catalyst on irc.perl.org.
2393
2394 Mailing Lists:
2395
2396     http://lists.rawmode.org/mailman/listinfo/catalyst
2397     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
2398
2399 Web:
2400
2401     http://catalyst.perl.org
2402
2403 Wiki:
2404
2405     http://dev.catalyst.perl.org
2406
2407 =head1 SEE ALSO
2408
2409 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2410
2411 =head2 L<Catalyst::Manual> - The Catalyst Manual
2412
2413 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2414
2415 =head2 L<Catalyst::Engine> - Core engine
2416
2417 =head2 L<Catalyst::Log> - Log class.
2418
2419 =head2 L<Catalyst::Request> - Request object
2420
2421 =head2 L<Catalyst::Response> - Response object
2422
2423 =head2 L<Catalyst::Test> - The test suite.
2424
2425 =head1 PROJECT FOUNDER
2426
2427 sri: Sebastian Riedel <sri@cpan.org>
2428
2429 =head1 CONTRIBUTORS
2430
2431 abw: Andy Wardley
2432
2433 acme: Leon Brocard <leon@astray.com>
2434
2435 Andrew Bramble
2436
2437 Andrew Ford
2438
2439 Andrew Ruthven
2440
2441 andyg: Andy Grundman <andy@hybridized.org>
2442
2443 audreyt: Audrey Tang
2444
2445 bricas: Brian Cassidy <bricas@cpan.org>
2446
2447 chansen: Christian Hansen
2448
2449 chicks: Christopher Hicks
2450
2451 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2452
2453 Drew Taylor
2454
2455 esskar: Sascha Kiefer
2456
2457 fireartist: Carl Franks <cfranks@cpan.org>
2458
2459 gabb: Danijel Milicevic
2460
2461 Gary Ashton Jones
2462
2463 Geoff Richards
2464
2465 jcamacho: Juan Camacho
2466
2467 Jody Belka
2468
2469 Johan Lindstrom
2470
2471 jon: Jon Schutz <jjschutz@cpan.org>
2472
2473 marcus: Marcus Ramberg <mramberg@cpan.org>
2474
2475 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2476
2477 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2478
2479 mugwump: Sam Vilain
2480
2481 naughton: David Naughton
2482
2483 ningu: David Kamholz <dkamholz@cpan.org>
2484
2485 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2486
2487 numa: Dan Sully <daniel@cpan.org>
2488
2489 obra: Jesse Vincent
2490
2491 omega: Andreas Marienborg
2492
2493 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2494
2495 sky: Arthur Bergman
2496
2497 the_jester: Jesse Sheidlower
2498
2499 Ulf Edvinsson
2500
2501 willert: Sebastian Willert <willert@cpan.org>
2502
2503 =head1 LICENSE
2504
2505 This library is free software, you can redistribute it and/or modify it under
2506 the same terms as Perl itself.
2507
2508 =cut
2509
2510 1;