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