lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 use Moose::Meta::Class ();
   5 extends 'Catalyst::Component';
   6 use Moose::Util qw/find_meta/;
   7 use B::Hooks::EndOfScope ();
   8 use Catalyst::Exception;
   9 use Catalyst::Exception::Detach;
  10 use Catalyst::Exception::Go;
  11 use Catalyst::Log;
  12 use Catalyst::Request;
  13 use Catalyst::Request::Upload;
  14 use Catalyst::Response;
  15 use Catalyst::Utils;
  16 use Catalyst::Controller;
  17 use Data::OptList;
  18 use Devel::InnerPackage ();
  19 use File::stat;
  20 use Module::Pluggable::Object ();
  21 use Text::SimpleTable ();
  22 use Path::Class::Dir ();
  23 use Path::Class::File ();
  24 use URI ();
  25 use URI::http;
  26 use URI::https;
  27 use Tree::Simple qw/use_weak_refs/;
  28 use Tree::Simple::Visitor::FindByUID;
  29 use Class::C3::Adopt::NEXT;
  30 use List::MoreUtils qw/uniq/;
  31 use attributes;
  32 use utf8;
  33 use Carp qw/croak carp shortmess/;
  34
  35 BEGIN { require 5.008004; }
  36
  37 has stack => (is => 'ro', default => sub { [] });
  38 has stash => (is => 'rw', default => sub { {} });
  39 has state => (is => 'rw', default => 0);
  40 has stats => (is => 'rw');
  41 has action => (is => 'rw');
  42 has counter => (is => 'rw', default => sub { {} });
  43 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
  44 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
  45 has namespace => (is => 'rw');
  46
  47 sub depth { scalar @{ shift->stack || [] }; }
  48 sub comp { shift->component(@_) }
  49
  50 sub req {
  51     my $self = shift; return $self->request(@_);
  52 }
  53 sub res {
  54     my $self = shift; return $self->response(@_);
  55 }
  56
  57 # For backwards compatibility
  58 sub finalize_output { shift->finalize_body(@_) };
  59
  60 # For statistics
  61 our $COUNT     = 1;
  62 our $START     = time;
  63 our $RECURSION = 1000;
  64 our $DETACH    = Catalyst::Exception::Detach->new;
  65 our $GO        = Catalyst::Exception::Go->new;
  66
  67 #I imagine that very few of these really need to be class variables. if any.
  68 #maybe we should just make them attributes with a default?
  69 __PACKAGE__->mk_classdata($_)
  70   for qw/container components arguments dispatcher engine log dispatcher_class
  71   engine_class context_class request_class response_class stats_class
  72   setup_finished/;
  73
  74 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  75 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  76 __PACKAGE__->request_class('Catalyst::Request');
  77 __PACKAGE__->response_class('Catalyst::Response');
  78 __PACKAGE__->stats_class('Catalyst::Stats');
  79
  80 # Remember to update this in Catalyst::Runtime as well!
  81
  82 our $VERSION = '5.80032';
  83
  84 sub import {
  85     my ( $class, @arguments ) = @_;
  86
  87     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  88     # callers @ISA.
  89     return unless $class eq 'Catalyst';
  90
  91     my $caller = caller();
  92     return if $caller eq 'main';
  93
  94     my $meta = Moose::Meta::Class->initialize($caller);
  95     unless ( $caller->isa('Catalyst') ) {
  96         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
  97         $meta->superclasses(@superclasses);
  98     }
  99     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
 100     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 101
 102     unless( $meta->has_method('meta') ){
 103         if ($Moose::VERSION >= 1.15) {
 104             $meta->_add_meta_method('meta');
 105         }
 106         else {
 107             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
 108         }
 109     }
 110
 111     $caller->arguments( [@arguments] );
 112     $caller->setup_home;
 113 }
 114
 115 sub _application { $_[0] }
 116
 117 =head1 NAME
 118
 119 Catalyst - The Elegant MVC Web Application Framework
 120
 121 =head1 SYNOPSIS
 122
 123 See the L<Catalyst::Manual> distribution for comprehensive
 124 documentation and tutorials.
 125
 126     # Install Catalyst::Devel for helpers and other development tools
 127     # use the helper to create a new application
 128     catalyst.pl MyApp
 129
 130     # add models, views, controllers
 131     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 132     script/myapp_create.pl view MyTemplate TT
 133     script/myapp_create.pl controller Search
 134
 135     # built in testserver -- use -r to restart automatically on changes
 136     # --help to see all available options
 137     script/myapp_server.pl
 138
 139     # command line testing interface
 140     script/myapp_test.pl /yada
 141
 142     ### in lib/MyApp.pm
 143     use Catalyst qw/-Debug/; # include plugins here as well
 144
 145     ### In lib/MyApp/Controller/Root.pm (autocreated)
 146     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 147         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 148         $c->stash->{template} = 'foo.tt'; # set the template
 149         # lookup something from db -- stash vars are passed to TT
 150         $c->stash->{data} =
 151           $c->model('Database::Foo')->search( { country => $args[0] } );
 152         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 153             $c->forward( 'bar' ); # process another action
 154             # do something else after forward returns
 155         }
 156     }
 157
 158     # The foo.tt TT template can use the stash data from the database
 159     [% WHILE (item = data.next) %]
 160         [% item.foo %]
 161     [% END %]
 162
 163     # called for /bar/of/soap, /bar/of/soap/10, etc.
 164     sub bar : Path('/bar/of/soap') { ... }
 165
 166     # called for all actions, from the top-most controller downwards
 167     sub auto : Private {
 168         my ( $self, $c ) = @_;
 169         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 170             $c->res->redirect( '/login' ); # require login
 171             return 0; # abort request and go immediately to end()
 172         }
 173         return 1; # success; carry on to next action
 174     }
 175
 176     # called after all actions are finished
 177     sub end : Private {
 178         my ( $self, $c ) = @_;
 179         if ( scalar @{ $c->error } ) { ... } # handle errors
 180         return if $c->res->body; # already have a response
 181         $c->forward( 'MyApp::View::TT' ); # render template
 182     }
 183
 184     ### in MyApp/Controller/Foo.pm
 185     # called for /foo/bar
 186     sub bar : Local { ... }
 187
 188     # called for /blargle
 189     sub blargle : Global { ... }
 190
 191     # an index action matches /foo, but not /foo/1, etc.
 192     sub index : Private { ... }
 193
 194     ### in MyApp/Controller/Foo/Bar.pm
 195     # called for /foo/bar/baz
 196     sub baz : Local { ... }
 197
 198     # first Root auto is called, then Foo auto, then this
 199     sub auto : Private { ... }
 200
 201     # powerful regular expression paths are also possible
 202     sub details : Regex('^product/(\w+)/details$') {
 203         my ( $self, $c ) = @_;
 204         # extract the (\w+) from the URI
 205         my $product = $c->req->captures->[0];
 206     }
 207
 208 See L<Catalyst::Manual::Intro> for additional information.
 209
 210 =head1 DESCRIPTION
 211
 212 Catalyst is a modern framework for making web applications without the
 213 pain usually associated with this process. This document is a reference
 214 to the main Catalyst application. If you are a new user, we suggest you
 215 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 216
 217 See L<Catalyst::Manual> for more documentation.
 218
 219 Catalyst plugins can be loaded by naming them as arguments to the "use
 220 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 221 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 222 C<My::Module>.
 223
 224     use Catalyst qw/My::Module/;
 225
 226 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 227 fully qualify the name by using a unary plus:
 228
 229     use Catalyst qw/
 230         My::Module
 231         +Fully::Qualified::Plugin::Name
 232     /;
 233
 234 Special flags like C<-Debug> and C<-Engine> can also be specified as
 235 arguments when Catalyst is loaded:
 236
 237     use Catalyst qw/-Debug My::Module/;
 238
 239 The position of plugins and flags in the chain is important, because
 240 they are loaded in the order in which they appear.
 241
 242 The following flags are supported:
 243
 244 =head2 -Debug
 245
 246 Enables debug output. You can also force this setting from the system
 247 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 248 settings override the application, with <MYAPP>_DEBUG having the highest
 249 priority.
 250
 251 This sets the log level to 'debug' and enables full debug output on the
 252 error screen. If you only want the latter, see L<< $c->debug >>.
 253
 254 =head2 -Engine
 255
 256 Forces Catalyst to use a specific engine. Omit the
 257 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 258
 259     use Catalyst qw/-Engine=CGI/;
 260
 261 =head2 -Home
 262
 263 Forces Catalyst to use a specific home directory, e.g.:
 264
 265     use Catalyst qw[-Home=/usr/mst];
 266
 267 This can also be done in the shell environment by setting either the
 268 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 269 is replaced with the uppercased name of your application, any "::" in
 270 the name will be replaced with underscores, e.g. MyApp::Web should use
 271 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 272
 273 If none of these are set, Catalyst will attempt to automatically detect the
 274 home directory. If you are working in a development envirnoment, Catalyst
 275 will try and find the directory containing either Makefile.PL, Build.PL or
 276 dist.ini. If the application has been installed into the system (i.e.
 277 you have done C<make install>), then Catalyst will use the path to your
 278 application module, without the .pm extension (ie, /foo/MyApp if your
 279 application was installed at /foo/MyApp.pm)
 280
 281 =head2 -Log
 282
 283     use Catalyst '-Log=warn,fatal,error';
 284
 285 Specifies a comma-delimited list of log levels.
 286
 287 =head2 -Stats
 288
 289 Enables statistics collection and reporting.
 290
 291    use Catalyst qw/-Stats=1/;
 292
 293 You can also force this setting from the system environment with CATALYST_STATS
 294 or <MYAPP>_STATS. The environment settings override the application, with
 295 <MYAPP>_STATS having the highest priority.
 296
 297 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
 298
 299 =head1 METHODS
 300
 301 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 302
 303 =head2 $c->action
 304
 305 Returns a L<Catalyst::Action> object for the current action, which
 306 stringifies to the action name. See L<Catalyst::Action>.
 307
 308 =head2 $c->namespace
 309
 310 Returns the namespace of the current action, i.e., the URI prefix
 311 corresponding to the controller of the current action. For example:
 312
 313     # in Controller::Foo::Bar
 314     $c->namespace; # returns 'foo/bar';
 315
 316 =head2 $c->request
 317
 318 =head2 $c->req
 319
 320 Returns the current L<Catalyst::Request> object, giving access to
 321 information about the current client request (including parameters,
 322 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 323
 324 =head2 REQUEST FLOW HANDLING
 325
 326 =head2 $c->forward( $action [, \@arguments ] )
 327
 328 =head2 $c->forward( $class, $method, [, \@arguments ] )
 329
 330 Forwards processing to another action, by its private name. If you give a
 331 class name but no method, C<process()> is called. You may also optionally
 332 pass arguments in an arrayref. The action will receive the arguments in
 333 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 334 C<< $c->req->args >> will be restored to the previous values.
 335
 336 Any data C<return>ed from the action forwarded to, will be returned by the
 337 call to forward.
 338
 339     my $foodata = $c->forward('/foo');
 340     $c->forward('index');
 341     $c->forward(qw/Model::DBIC::Foo do_stuff/);
 342     $c->forward('View::TT');
 343
 344 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 345 an C<< eval { } >> around the call (actually
 346 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
 347 all 'dies' within the called action. If you want C<die> to propagate you
 348 need to do something like:
 349
 350     $c->forward('foo');
 351     die join "\n", @{ $c->error } if @{ $c->error };
 352
 353 Or make sure to always return true values from your actions and write
 354 your code like this:
 355
 356     $c->forward('foo') || return;
 357
 358 Another note is that C<< $c->forward >> always returns a scalar because it
 359 actually returns $c->state which operates in a scalar context.
 360 Thus, something like:
 361
 362     return @array;
 363
 364 in an action that is forwarded to is going to return a scalar,
 365 i.e. how many items are in that array, which is probably not what you want.
 366 If you need to return an array then return a reference to it,
 367 or stash it like so:
 368
 369     $c->stash->{array} = \@array;
 370
 371 and access it from the stash.
 372
 373 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
 374
 375 =cut
 376
 377 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
 378
 379 =head2 $c->detach( $action [, \@arguments ] )
 380
 381 =head2 $c->detach( $class, $method, [, \@arguments ] )
 382
 383 =head2 $c->detach()
 384
 385 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
 386 doesn't return to the previous action when processing is finished.
 387
 388 When called with no arguments it escapes the processing chain entirely.
 389
 390 =cut
 391
 392 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 393
 394 =head2 $c->visit( $action [, \@captures, \@arguments ] )
 395
 396 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
 397
 398 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
 399 but does a full dispatch, instead of just calling the new C<$action> /
 400 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
 401 you go to are called, just like a new request.
 402
 403 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
 404 This means, for example, that C<< $c->action >> methods such as
 405 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
 406 L<reverse|Catalyst::Action/reverse> return information for the visited action
 407 when they are invoked within the visited action.  This is different from the
 408 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 409 continues to use the $c->action object from the caller action even when
 410 invoked from the callee.
 411
 412 C<< $c->stash >> is kept unchanged.
 413
 414 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
 415 allows you to "wrap" another action, just as it would have been called by
 416 dispatching from a URL, while the analogous
 417 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
 418 transfer control to another action as if it had been reached directly from a URL.
 419
 420 =cut
 421
 422 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 423
 424 =head2 $c->go( $action [, \@captures, \@arguments ] )
 425
 426 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 427
 428 The relationship between C<go> and
 429 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
 430 the relationship between
 431 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
 432 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 433 C<< $c->go >> will perform a full dispatch on the specified action or method,
 434 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 435 C<go> escapes the processing of the current request chain on completion, and
 436 does not return to its caller.
 437
 438 @arguments are arguments to the final destination of $action. @captures are
 439 arguments to the intermediate steps, if any, on the way to the final sub of
 440 $action.
 441
 442 =cut
 443
 444 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 445
 446 =head2 $c->response
 447
 448 =head2 $c->res
 449
 450 Returns the current L<Catalyst::Response> object, see there for details.
 451
 452 =head2 $c->stash
 453
 454 Returns a hashref to the stash, which may be used to store data and pass
 455 it between components during a request. You can also set hash keys by
 456 passing arguments. The stash is automatically sent to the view. The
 457 stash is cleared at the end of a request; it cannot be used for
 458 persistent storage (for this you must use a session; see
 459 L<Catalyst::Plugin::Session> for a complete system integrated with
 460 Catalyst).
 461
 462     $c->stash->{foo} = $bar;
 463     $c->stash( { moose => 'majestic', qux => 0 } );
 464     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 465
 466     # stash is automatically passed to the view for use in a template
 467     $c->forward( 'MyApp::View::TT' );
 468
 469 =cut
 470
 471 around stash => sub {
 472     my $orig = shift;
 473     my $c = shift;
 474     my $stash = $orig->($c);
 475     if (@_) {
 476         my $new_stash = @_ > 1 ? {@_} : $_[0];
 477         croak('stash takes a hash or hashref') unless ref $new_stash;
 478         foreach my $key ( keys %$new_stash ) {
 479           $stash->{$key} = $new_stash->{$key};
 480         }
 481     }
 482
 483     return $stash;
 484 };
 485
 486
 487 =head2 $c->error
 488
 489 =head2 $c->error($error, ...)
 490
 491 =head2 $c->error($arrayref)
 492
 493 Returns an arrayref containing error messages.  If Catalyst encounters an
 494 error while processing a request, it stores the error in $c->error.  This
 495 method should only be used to store fatal error messages.
 496
 497     my @error = @{ $c->error };
 498
 499 Add a new error.
 500
 501     $c->error('Something bad happened');
 502
 503 =cut
 504
 505 sub error {
 506     my $c = shift;
 507     if ( $_[0] ) {
 508         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 509         croak @$error unless ref $c;
 510         push @{ $c->{error} }, @$error;
 511     }
 512     elsif ( defined $_[0] ) { $c->{error} = undef }
 513     return $c->{error} || [];
 514 }
 515
 516
 517 =head2 $c->state
 518
 519 Contains the return value of the last executed action.
 520 Note that << $c->state >> operates in a scalar context which means that all
 521 values it returns are scalar.
 522
 523 =head2 $c->clear_errors
 524
 525 Clear errors.  You probably don't want to clear the errors unless you are
 526 implementing a custom error screen.
 527
 528 This is equivalent to running
 529
 530     $c->error(0);
 531
 532 =cut
 533
 534 sub clear_errors {
 535     my $c = shift;
 536     $c->error(0);
 537 }
 538
 539 =head2 COMPONENT ACCESSORS
 540
 541 =head2 $c->controller($name)
 542
 543 Gets a L<Catalyst::Controller> instance by name.
 544
 545     $c->controller('Foo')->do_stuff;
 546
 547 If the name is omitted, will return the controller for the dispatched
 548 action.
 549
 550 If you want to search for controllers, pass in a regexp as the argument.
 551
 552     # find all controllers that start with Foo
 553     my @foo_controllers = $c->controller(qr{^Foo});
 554
 555
 556 =cut
 557
 558 sub controller {
 559     my ( $c, $name, @args ) = @_;
 560     my $container = $c->container->get_sub_container('controller');
 561
 562     my $appclass = ref $c || $c;
 563     if( $name ) {
 564         if ( !ref $name ) { # Direct component hash lookup to avoid costly regexps
 565             return $container->resolve(service => $name, parameters => { context => [ $c, @args ] } )
 566                 if $container->has_service($name);
 567         }
 568
 569         return
 570             if $c->config->{disable_component_resolution_regex_fallback} && !ref $name;
 571
 572         my @comps = $container->get_service_list;
 573         my @result;
 574         for (@comps) {
 575             push @result, $container->resolve( service => $_, parameters => { context => [ $c, @args ] } )
 576                 if m/$name/;
 577         }
 578
 579         if (@result) {
 580             if (!ref $name) {
 581                 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 582                 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 583                 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 584             }
 585
 586             return @result;
 587         }
 588
 589         return;
 590     }
 591
 592     return $c->component( $c->action->class );
 593 }
 594
 595 =head2 $c->model($name)
 596
 597 Gets a L<Catalyst::Model> instance by name.
 598
 599     $c->model('Foo')->do_stuff;
 600
 601 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 602
 603 If the name is omitted, it will look for
 604  - a model object in $c->stash->{current_model_instance}, then
 605  - a model name in $c->stash->{current_model}, then
 606  - a config setting 'default_model', or
 607  - check if there is only one model, and return it if that's the case.
 608
 609 If you want to search for models, pass in a regexp as the argument.
 610
 611     # find all models that start with Foo
 612     my @foo_models = $c->model(qr{^Foo});
 613
 614 =cut
 615
 616 sub model {
 617     my ( $c, $name, @args ) = @_;
 618     my $appclass = ref($c) || $c;
 619     my $container = $c->container->get_sub_container('model');
 620
 621     if( $name ) {
 622         if ( !ref $name && $container->has_service($name)) { # Direct component hash lookup to avoid costly regexps
 623             return $container->resolve( service => $name, parameters => { context => [ $c, @args ] } );
 624         }
 625
 626         return
 627             if $c->config->{disable_component_resolution_regex_fallback} && !ref $name;
 628
 629         my @comps = $container->get_service_list;
 630         my @result;
 631         for (@comps) {
 632             push @result, $container->resolve( service => $_, parameters => { context => [ $c, @args ] } )
 633                 if m/$name/;
 634         }
 635
 636         if (@result) {
 637             if (!ref $name) {
 638                 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 639                 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 640                 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 641             }
 642
 643             return @result;
 644         }
 645
 646         return;
 647     }
 648
 649     if (ref $c) {
 650         return $c->stash->{current_model_instance}
 651           if $c->stash->{current_model_instance};
 652         return $c->model( $c->stash->{current_model} )
 653           if $c->stash->{current_model};
 654     }
 655     return $c->model( $appclass->config->{default_model} )
 656       if $appclass->config->{default_model};
 657
 658 # FIXME: will this still be mantained?
 659     my( $comp, $rest ) = $container->get_service_list;
 660
 661     if( $rest ) {
 662         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
 663         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
 664         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 665         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 666         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 667     }
 668
 669     return $container->resolve( service => $comp, parameters => { context => [ $c, @args ] } );
 670 }
 671
 672
 673 =head2 $c->view($name)
 674
 675 Gets a L<Catalyst::View> instance by name.
 676
 677     $c->view('Foo')->do_stuff;
 678
 679 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 680
 681 If the name is omitted, it will look for
 682  - a view object in $c->stash->{current_view_instance}, then
 683  - a view name in $c->stash->{current_view}, then
 684  - a config setting 'default_view', or
 685  - check if there is only one view, and return it if that's the case.
 686
 687 If you want to search for views, pass in a regexp as the argument.
 688
 689     # find all views that start with Foo
 690     my @foo_views = $c->view(qr{^Foo});
 691
 692 =cut
 693
 694 sub view {
 695     my ( $c, $name, @args ) = @_;
 696     my $appclass = ref($c) || $c;
 697     my $container = $c->container->get_sub_container('view');
 698
 699     if( $name ) {
 700         if ( !ref $name ) { # Direct component hash lookup to avoid costly regexps
 701             if ( $container->has_service($name) ) {
 702                 return $container->resolve( service => $name, parameters => { context => [ $c, @args ] } );
 703             }
 704             else {
 705                 $c->log->warn( "Attempted to use view '$name', but does not exist" );
 706             }
 707         }
 708
 709         return
 710             if $c->config->{disable_component_resolution_regex_fallback} && !ref $name;
 711
 712         my @comps = $container->get_service_list;
 713         my @result;
 714         for (@comps) {
 715             push @result, $container->resolve( service => $_, parameters => { context => [ $c, @args ] } )
 716                 if m/$name/;
 717         }
 718
 719         if (@result) {
 720             if (!ref $name) {
 721                 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 722                 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 723                 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 724             }
 725
 726             return @result;
 727         }
 728
 729         return;
 730     }
 731
 732     if (ref $c) {
 733         return $c->stash->{current_view_instance}
 734           if $c->stash->{current_view_instance};
 735         return $c->view( $c->stash->{current_view} )
 736           if $c->stash->{current_view};
 737     }
 738     return $c->view( $appclass->config->{default_view} )
 739       if $appclass->config->{default_view};
 740
 741     my( $comp, $rest ) = $container->get_service_list;
 742
 743     if( $rest ) {
 744         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 745         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
 746         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 747         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 748         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 749     }
 750
 751     return $container->resolve( service => $comp, parameters => { context => [ $c, @args ] } );
 752 }
 753
 754 =head2 $c->controllers
 755
 756 Returns the available names which can be passed to $c->controller
 757
 758 =cut
 759
 760 sub controllers {
 761     my ( $c ) = @_;
 762     return $c->container->get_sub_container('controller')->get_service_list;
 763 }
 764
 765 =head2 $c->models
 766
 767 Returns the available names which can be passed to $c->model
 768
 769 =cut
 770
 771 sub models {
 772     my ( $c ) = @_;
 773     return $c->container->get_sub_container('model')->get_service_list;
 774 }
 775
 776
 777 =head2 $c->views
 778
 779 Returns the available names which can be passed to $c->view
 780
 781 =cut
 782
 783 sub views {
 784     my ( $c ) = @_;
 785     return $c->container->get_sub_container('view')->get_service_list;
 786 }
 787
 788 =head2 $c->comp($name)
 789
 790 =head2 $c->component($name)
 791
 792 Gets a component object by name. This method is not recommended,
 793 unless you want to get a specific component by full
 794 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 795 should be used instead.
 796
 797 If C<$name> is a regexp, a list of components matched against the full
 798 component name will be returned.
 799
 800 If Catalyst can't find a component by name, it will fallback to regex
 801 matching by default. To disable this behaviour set
 802 disable_component_resolution_regex_fallback to a true value.
 803
 804     __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
 805
 806 =cut
 807
 808 sub component {
 809     my ( $c, $component, @args ) = @_;
 810
 811     if ( $component ) {
 812         my ($type, $name) = _get_component_type_name($component);
 813
 814         if ($type && $c->container->has_sub_container($type)) {
 815             my $container = $c->container->get_sub_container($type);
 816
 817             if( !ref $component && $container->has_service($name) ) {
 818                 return $container->resolve( service => $name, parameters => { context => [ $c, @args ] } );
 819             }
 820         }
 821
 822         return
 823             if $c->config->{disable_component_resolution_regex_fallback};
 824
 825         # This is here so $c->comp( '::M::' ) works
 826         my $query = ref $component ? $component : qr{$component}i;
 827
 828         for my $subcontainer_name (qw/model view controller/) {
 829             my $subcontainer = $c->container->get_sub_container($subcontainer_name);
 830             my @components   = $subcontainer->get_service_list;
 831             my @result       = grep { m{$query} } @components;
 832
 833             if (@result) {
 834                 return map { $subcontainer->resolve( service => $_, parameters => { context => [$c, @args] } ) } @result
 835                     if ref $component;
 836
 837                 $c->log->warn( Carp::shortmess(qq(Found results for "${component}" using regexp fallback)) );
 838                 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 839                 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 840
 841                 return $subcontainer->resolve( service => $result[0], parameters => { context => [$c, @args] } );
 842             }
 843         }
 844
 845         # I would expect to return an empty list here, but that breaks back-compat
 846     }
 847
 848     # fallback
 849     return sort keys %{ $c->components };
 850 }
 851
 852 =head2 CLASS DATA AND HELPER CLASSES
 853
 854 =head2 $c->config
 855
 856 Returns or takes a hashref containing the application's configuration.
 857
 858     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 859
 860 You can also use a C<YAML>, C<XML> or L<Config::General> config file
 861 like C<myapp.conf> in your applications home directory. See
 862 L<Catalyst::Plugin::ConfigLoader>.
 863
 864 =head3 Cascading configuration
 865
 866 The config method is present on all Catalyst components, and configuration
 867 will be merged when an application is started. Configuration loaded with
 868 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
 869 followed by configuration in your top level C<MyApp> class. These two
 870 configurations are merged, and then configuration data whose hash key matches a
 871 component name is merged with configuration for that component.
 872
 873 The configuration for a component is then passed to the C<new> method when a
 874 component is constructed.
 875
 876 For example:
 877
 878     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
 879     MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
 880
 881 will mean that C<MyApp::Model::Foo> receives the following data when
 882 constructed:
 883
 884     MyApp::Model::Foo->new({
 885         bar => 'baz',
 886         quux => 'frob',
 887         overrides => 'me',
 888     });
 889
 890 It's common practice to use a Moose attribute
 891 on the receiving component to access the config value.
 892
 893     package MyApp::Model::Foo;
 894
 895     use Moose;
 896
 897     # this attr will receive 'baz' at construction time
 898     has 'bar' => (
 899         is  => 'rw',
 900         isa => 'Str',
 901     );
 902
 903 You can then get the value 'baz' by calling $c->model('Foo')->bar
 904 (or $self->bar inside code in the model).
 905
 906 B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
 907 as a way of reading config within your code, as this B<will not> give you the
 908 correctly merged config back. You B<MUST> take the config values supplied to
 909 the constructor and use those instead.
 910
 911 =cut
 912
 913 around config => sub {
 914     my $orig = shift;
 915     my $c = shift;
 916
 917     croak('Setting config after setup has been run is not allowed.')
 918         if ( @_ and $c->setup_finished );
 919
 920     $c->$orig(@_);
 921 };
 922
 923 =head2 $c->log
 924
 925 Returns the logging object instance. Unless it is already set, Catalyst
 926 sets this up with a L<Catalyst::Log> object. To use your own log class,
 927 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 928 C<< __PACKAGE__->setup >>.
 929
 930  __PACKAGE__->log( MyLogger->new );
 931  __PACKAGE__->setup;
 932
 933 And later:
 934
 935     $c->log->info( 'Now logging with my own logger!' );
 936
 937 Your log class should implement the methods described in
 938 L<Catalyst::Log>.
 939
 940
 941 =head2 $c->debug
 942
 943 Returns 1 if debug mode is enabled, 0 otherwise.
 944
 945 You can enable debug mode in several ways:
 946
 947 =over
 948
 949 =item By calling myapp_server.pl with the -d flag
 950
 951 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
 952
 953 =item The -Debug option in your MyApp.pm
 954
 955 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
 956
 957 =back
 958
 959 The first three also set the log level to 'debug'.
 960
 961 Calling C<< $c->debug(1) >> has no effect.
 962
 963 =cut
 964
 965 sub debug { 0 }
 966
 967 =head2 $c->dispatcher
 968
 969 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
 970
 971 =head2 $c->engine
 972
 973 Returns the engine instance. See L<Catalyst::Engine>.
 974
 975
 976 =head2 UTILITY METHODS
 977
 978 =head2 $c->path_to(@path)
 979
 980 Merges C<@path> with C<< $c->config->{home} >> and returns a
 981 L<Path::Class::Dir> object. Note you can usually use this object as
 982 a filename, but sometimes you will have to explicitly stringify it
 983 yourself by calling the C<< ->stringify >> method.
 984
 985 For example:
 986
 987     $c->path_to( 'db', 'sqlite.db' );
 988
 989 =cut
 990
 991 sub path_to {
 992     my ( $c, @path ) = @_;
 993     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 994     if ( -d $path ) { return $path }
 995     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 996 }
 997
 998 =head2 $c->plugin( $name, $class, @args )
 999
1000 Helper method for plugins. It creates a class data accessor/mutator and
1001 loads and instantiates the given class.
1002
1003     MyApp->plugin( 'prototype', 'HTML::Prototype' );
1004
1005     $c->prototype->define_javascript_functions;
1006
1007 B<Note:> This method of adding plugins is deprecated. The ability
1008 to add plugins like this B<will be removed> in a Catalyst 5.81.
1009 Please do not use this functionality in new code.
1010
1011 =cut
1012
1013 sub plugin {
1014     my ( $class, $name, $plugin, @args ) = @_;
1015
1016     # See block comment in t/unit_core_plugin.t
1017     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
1018
1019     $class->_register_plugin( $plugin, 1 );
1020
1021     eval { $plugin->import };
1022     $class->mk_classdata($name);
1023     my $obj;
1024     eval { $obj = $plugin->new(@args) };
1025
1026     if ($@) {
1027         Catalyst::Exception->throw( message =>
1028               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1029     }
1030
1031     $class->$name($obj);
1032     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1033       if $class->debug;
1034 }
1035
1036 =head2 MyApp->setup
1037
1038 Initializes the dispatcher and engine, loads any plugins, and loads the
1039 model, view, and controller components. You may also specify an array
1040 of plugins to load here, if you choose to not load them in the C<use
1041 Catalyst> line.
1042
1043     MyApp->setup;
1044     MyApp->setup( qw/-Debug/ );
1045
1046 =cut
1047
1048 sub setup {
1049     my ( $class, @arguments ) = @_;
1050     croak('Running setup more than once')
1051         if ( $class->setup_finished );
1052
1053     unless ( $class->isa('Catalyst') ) {
1054
1055         Catalyst::Exception->throw(
1056             message => qq/'$class' does not inherit from Catalyst/ );
1057     }
1058
1059     if ( $class->arguments ) {
1060         @arguments = ( @arguments, @{ $class->arguments } );
1061     }
1062
1063     # Process options
1064     my $flags = {};
1065
1066     foreach (@arguments) {
1067
1068         if (/^-Debug$/) {
1069             $flags->{log} =
1070               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1071         }
1072         elsif (/^-(\w+)=?(.*)$/) {
1073             $flags->{ lc $1 } = $2;
1074         }
1075         else {
1076             push @{ $flags->{plugins} }, $_;
1077         }
1078     }
1079
1080     $class->setup_config();
1081     $class->setup_home( delete $flags->{home} );
1082
1083     $class->setup_log( delete $flags->{log} );
1084     $class->setup_plugins( delete $flags->{plugins} );
1085     $class->setup_dispatcher( delete $flags->{dispatcher} );
1086     $class->setup_engine( delete $flags->{engine} );
1087     $class->setup_stats( delete $flags->{stats} );
1088
1089     for my $flag ( sort keys %{$flags} ) {
1090
1091         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1092             &$code( $class, delete $flags->{$flag} );
1093         }
1094         else {
1095             $class->log->warn(qq/Unknown flag "$flag"/);
1096         }
1097     }
1098
1099     eval { require Catalyst::Devel; };
1100     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1101         $class->log->warn(<<"EOF");
1102 You are running an old script!
1103
1104   Please update by running (this will overwrite existing files):
1105     catalyst.pl -force -scripts $class
1106
1107   or (this will not overwrite existing files):
1108     catalyst.pl -scripts $class
1109
1110 EOF
1111     }
1112
1113     if ( $class->debug ) {
1114         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1115
1116         if (@plugins) {
1117             my $column_width = Catalyst::Utils::term_width() - 6;
1118             my $t = Text::SimpleTable->new($column_width);
1119             $t->row($_) for @plugins;
1120             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1121         }
1122
1123         my $dispatcher = $class->dispatcher;
1124         my $engine     = $class->engine;
1125         my $home       = $class->config->{home};
1126
1127         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1128         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1129
1130         $home
1131           ? ( -d $home )
1132           ? $class->log->debug(qq/Found home "$home"/)
1133           : $class->log->debug(qq/Home "$home" doesn't exist/)
1134           : $class->log->debug(q/Couldn't find home/);
1135     }
1136
1137     # Call plugins setup, this is stupid and evil.
1138     # Also screws C3 badly on 5.10, hack to avoid.
1139     {
1140         no warnings qw/redefine/;
1141         local *setup = sub { };
1142         $class->setup unless $Catalyst::__AM_RESTARTING;
1143     }
1144
1145     # Initialize our data structure
1146     $class->components( {} );
1147
1148     $class->setup_components;
1149
1150     if ( $class->debug ) {
1151         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1152         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1153         for my $comp ( sort keys %{ $class->components } ) {
1154             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1155             $t->row( $comp, $type );
1156         }
1157         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1158           if ( keys %{ $class->components } );
1159     }
1160
1161     # Add our self to components, since we are also a component
1162     if( $class->isa('Catalyst::Controller') ){
1163       $class->components->{$class} = $class;
1164     }
1165
1166     $class->setup_actions;
1167
1168     if ( $class->debug ) {
1169         my $name = $class->config->{name} || 'Application';
1170         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1171     }
1172
1173     # Make sure that the application class becomes immutable at this point,
1174     B::Hooks::EndOfScope::on_scope_end {
1175         return if $@;
1176         my $meta = Class::MOP::get_metaclass_by_name($class);
1177         if (
1178             $meta->is_immutable
1179             && ! { $meta->immutable_options }->{replace_constructor}
1180             && (
1181                    $class->isa('Class::Accessor::Fast')
1182                 || $class->isa('Class::Accessor')
1183             )
1184         ) {
1185             warn "You made your application class ($class) immutable, "
1186                 . "but did not inline the\nconstructor. "
1187                 . "This will break catalyst, as your app \@ISA "
1188                 . "Class::Accessor(::Fast)?\nPlease pass "
1189                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1190         }
1191         $meta->make_immutable(
1192             replace_constructor => 1,
1193         ) unless $meta->is_immutable;
1194     };
1195
1196     if ($class->config->{case_sensitive}) {
1197         $class->log->warn($class . "->config->{case_sensitive} is set.");
1198         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1199     }
1200
1201     $class->setup_finalize;
1202     # Should be the last thing we do so that user things hooking
1203     # setup_finalize can log..
1204     $class->log->_flush() if $class->log->can('_flush');
1205     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
1206 }
1207
1208 =head2 $app->setup_finalize
1209
1210 A hook to attach modifiers to. This method does not do anything except set the
1211 C<setup_finished> accessor.
1212
1213 Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
1214
1215 Example:
1216
1217     after setup_finalize => sub {
1218         my $app = shift;
1219
1220         ## do stuff here..
1221     };
1222
1223 =cut
1224
1225 sub setup_finalize {
1226     my ($class) = @_;
1227     $class->setup_finished(1);
1228 }
1229
1230 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1231
1232 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1233
1234 Constructs an absolute L<URI> object based on the application root, the
1235 provided path, and the additional arguments and query parameters provided.
1236 When used as a string, provides a textual URI.  If you need more flexibility
1237 than this (i.e. the option to provide relative URIs etc.) see
1238 L<Catalyst::Plugin::SmartURI>.
1239
1240 If no arguments are provided, the URI for the current action is returned.
1241 To return the current action and also provide @args, use
1242 C<< $c->uri_for( $c->action, @args ) >>.
1243
1244 If the first argument is a string, it is taken as a public URI path relative
1245 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1246 relative to the application root (if it does). It is then merged with
1247 C<< $c->request->base >>; any C<@args> are appended as additional path
1248 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1249
1250 If the first argument is a L<Catalyst::Action> it represents an action which
1251 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1252 optional C<\@captures> argument (an arrayref) allows passing the captured
1253 variables that are needed to fill in the paths of Chained and Regex actions;
1254 once the path is resolved, C<uri_for> continues as though a path was
1255 provided, appending any arguments or parameters and creating an absolute
1256 URI.
1257
1258 The captures for the current request can be found in
1259 C<< $c->request->captures >>, and actions can be resolved using
1260 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1261 path, use C<< $c->uri_for_action >> instead.
1262
1263   # Equivalent to $c->req->uri
1264   $c->uri_for($c->action, $c->req->captures,
1265       @{ $c->req->args }, $c->req->params);
1266
1267   # For the Foo action in the Bar controller
1268   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1269
1270   # Path to a static resource
1271   $c->uri_for('/static/images/logo.png');
1272
1273 =cut
1274
1275 sub uri_for {
1276     my ( $c, $path, @args ) = @_;
1277
1278     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1279         $path = $path->path_prefix;
1280         $path =~ s{/+\z}{};
1281         $path .= '/';
1282     }
1283
1284     undef($path) if (defined $path && $path eq '');
1285
1286     my $params =
1287       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1288
1289     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1290     foreach my $arg (@args) {
1291         utf8::encode($arg) if utf8::is_utf8($arg);
1292         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1293     }
1294
1295     if ( blessed($path) ) { # action object
1296         s|/|%2F|g for @args;
1297         my $captures = [ map { s|/|%2F|g; $_; }
1298                         ( scalar @args && ref $args[0] eq 'ARRAY'
1299                          ? @{ shift(@args) }
1300                          : ()) ];
1301
1302         foreach my $capture (@$captures) {
1303             utf8::encode($capture) if utf8::is_utf8($capture);
1304             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1305         }
1306
1307         my $action = $path;
1308         $path = $c->dispatcher->uri_for_action($action, $captures);
1309         if (not defined $path) {
1310             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1311                 if $c->debug;
1312             return undef;
1313         }
1314         $path = '/' if $path eq '';
1315     }
1316
1317     unshift(@args, $path);
1318
1319     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1320         my $namespace = $c->namespace;
1321         if (defined $path) { # cheesy hack to handle path '../foo'
1322            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1323         }
1324         unshift(@args, $namespace || '');
1325     }
1326
1327     # join args with '/', or a blank string
1328     my $args = join('/', grep { defined($_) } @args);
1329     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1330     $args =~ s!^/+!!;
1331     my $base = $c->req->base;
1332     my $class = ref($base);
1333     $base =~ s{(?<!/)$}{/};
1334
1335     my $query = '';
1336
1337     if (my @keys = keys %$params) {
1338       # somewhat lifted from URI::_query's query_form
1339       $query = '?'.join('&', map {
1340           my $val = $params->{$_};
1341           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1342           s/ /+/g;
1343           my $key = $_;
1344           $val = '' unless defined $val;
1345           (map {
1346               my $param = "$_";
1347               utf8::encode( $param ) if utf8::is_utf8($param);
1348               # using the URI::Escape pattern here so utf8 chars survive
1349               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1350               $param =~ s/ /+/g;
1351               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1352       } @keys);
1353     }
1354
1355     my $res = bless(\"${base}${args}${query}", $class);
1356     $res;
1357 }
1358
1359 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1360
1361 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1362
1363 =over
1364
1365 =item $path
1366
1367 A private path to the Catalyst action you want to create a URI for.
1368
1369 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1370 >> and passing the resulting C<$action> and the remaining arguments to C<<
1371 $c->uri_for >>.
1372
1373 You can also pass in a Catalyst::Action object, in which case it is passed to
1374 C<< $c->uri_for >>.
1375
1376 Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action.
1377
1378 For example, if the action looks like:
1379
1380  package MyApp::Controller::Users;
1381
1382  sub lst : Path('the-list') {}
1383
1384 You can use:
1385
1386  $c->uri_for_action('/users/lst')
1387
1388 and it will create the URI /users/the-list.
1389
1390 =back
1391
1392 =cut
1393
1394 sub uri_for_action {
1395     my ( $c, $path, @args ) = @_;
1396     my $action = blessed($path)
1397       ? $path
1398       : $c->dispatcher->get_action_by_path($path);
1399     unless (defined $action) {
1400       croak "Can't find action for path '$path'";
1401     }
1402     return $c->uri_for( $action, @args );
1403 }
1404
1405 =head2 $c->welcome_message
1406
1407 Returns the Catalyst welcome HTML page.
1408
1409 =cut
1410
1411 sub welcome_message {
1412     my $c      = shift;
1413     my $name   = $c->config->{name};
1414     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1415     my $prefix = Catalyst::Utils::appprefix( ref $c );
1416     $c->response->content_type('text/html; charset=utf-8');
1417     return <<"EOF";
1418 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1419     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1420 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1421     <head>
1422     <meta http-equiv="Content-Language" content="en" />
1423     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1424         <title>$name on Catalyst $VERSION</title>
1425         <style type="text/css">
1426             body {
1427                 color: #000;
1428                 background-color: #eee;
1429             }
1430             div#content {
1431                 width: 640px;
1432                 margin-left: auto;
1433                 margin-right: auto;
1434                 margin-top: 10px;
1435                 margin-bottom: 10px;
1436                 text-align: left;
1437                 background-color: #ccc;
1438                 border: 1px solid #aaa;
1439             }
1440             p, h1, h2 {
1441                 margin-left: 20px;
1442                 margin-right: 20px;
1443                 font-family: verdana, tahoma, sans-serif;
1444             }
1445             a {
1446                 font-family: verdana, tahoma, sans-serif;
1447             }
1448             :link, :visited {
1449                     text-decoration: none;
1450                     color: #b00;
1451                     border-bottom: 1px dotted #bbb;
1452             }
1453             :link:hover, :visited:hover {
1454                     color: #555;
1455             }
1456             div#topbar {
1457                 margin: 0px;
1458             }
1459             pre {
1460                 margin: 10px;
1461                 padding: 8px;
1462             }
1463             div#answers {
1464                 padding: 8px;
1465                 margin: 10px;
1466                 background-color: #fff;
1467                 border: 1px solid #aaa;
1468             }
1469             h1 {
1470                 font-size: 0.9em;
1471                 font-weight: normal;
1472                 text-align: center;
1473             }
1474             h2 {
1475                 font-size: 1.0em;
1476             }
1477             p {
1478                 font-size: 0.9em;
1479             }
1480             p img {
1481                 float: right;
1482                 margin-left: 10px;
1483             }
1484             span#appname {
1485                 font-weight: bold;
1486                 font-size: 1.6em;
1487             }
1488         </style>
1489     </head>
1490     <body>
1491         <div id="content">
1492             <div id="topbar">
1493                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1494                     $VERSION</h1>
1495              </div>
1496              <div id="answers">
1497                  <p>
1498                  <img src="$logo" alt="Catalyst Logo" />
1499                  </p>
1500                  <p>Welcome to the  world of Catalyst.
1501                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1502                     framework will make web development something you had
1503                     never expected it to be: Fun, rewarding, and quick.</p>
1504                  <h2>What to do now?</h2>
1505                  <p>That really depends  on what <b>you</b> want to do.
1506                     We do, however, provide you with a few starting points.</p>
1507                  <p>If you want to jump right into web development with Catalyst
1508                     you might want to start with a tutorial.</p>
1509 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1510 </pre>
1511 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1512 <pre>
1513 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1514 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1515 </code></pre>
1516                  <h2>What to do next?</h2>
1517                  <p>Next it's time to write an actual application. Use the
1518                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1519                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1520                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1521                     they can save you a lot of work.</p>
1522                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1523                     <p>Also, be sure to check out the vast and growing
1524                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1525                     you are likely to find what you need there.
1526                     </p>
1527
1528                  <h2>Need help?</h2>
1529                  <p>Catalyst has a very active community. Here are the main places to
1530                     get in touch with us.</p>
1531                  <ul>
1532                      <li>
1533                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1534                      </li>
1535                      <li>
1536                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1537                      </li>
1538                      <li>
1539                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1540                      </li>
1541                  </ul>
1542                  <h2>In conclusion</h2>
1543                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1544                     as we enjoyed making it. Please contact us if you have ideas
1545                     for improvement or other feedback.</p>
1546              </div>
1547          </div>
1548     </body>
1549 </html>
1550 EOF
1551 }
1552
1553 =head1 INTERNAL METHODS
1554
1555 These methods are not meant to be used by end users.
1556
1557 =head2 $c->components
1558
1559 Returns a hash of components.
1560
1561 =cut
1562
1563 around components => sub {
1564     my $orig  = shift;
1565     my $class = shift;
1566     my $comps = shift;
1567
1568     return $class->$orig if ( !$comps );
1569
1570 # FIXME: should this ugly kludge exist?
1571     $class->setup_config unless defined $class->container;
1572
1573 # FIXME: should there be a warning here, not to use this accessor to create the components?
1574     my $components = {};
1575
1576     my $containers;
1577     $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
1578
1579     for my $component ( keys %$comps ) {
1580         $components->{ $component } = $comps->{$component};
1581
1582         my ($type, $name) = _get_component_type_name($component);
1583
1584 # FIXME: shouldn't the service name be $name?
1585         $containers->{$type}->add_service(Catalyst::BlockInjection->new( name => $name, block => sub { return $class->setup_component($component) } ));
1586     }
1587
1588     return $class->$orig($components);
1589 };
1590
1591 =head2 $c->context_class
1592
1593 Returns or sets the context class.
1594
1595 =head2 $c->counter
1596
1597 Returns a hashref containing coderefs and execution counts (needed for
1598 deep recursion detection).
1599
1600 =head2 $c->depth
1601
1602 Returns the number of actions on the current internal execution stack.
1603
1604 =head2 $c->dispatch
1605
1606 Dispatches a request to actions.
1607
1608 =cut
1609
1610 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1611
1612 =head2 $c->dispatcher_class
1613
1614 Returns or sets the dispatcher class.
1615
1616 =head2 $c->dump_these
1617
1618 Returns a list of 2-element array references (name, structure) pairs
1619 that will be dumped on the error page in debug mode.
1620
1621 =cut
1622
1623 sub dump_these {
1624     my $c = shift;
1625     [ Request => $c->req ],
1626     [ Response => $c->res ],
1627     [ Stash => $c->stash ],
1628     [ Config => $c->config ];
1629 }
1630
1631 =head2 $c->engine_class
1632
1633 Returns or sets the engine class.
1634
1635 =head2 $c->execute( $class, $coderef )
1636
1637 Execute a coderef in given class and catch exceptions. Errors are available
1638 via $c->error.
1639
1640 =cut
1641
1642 sub execute {
1643     my ( $c, $class, $code ) = @_;
1644     $class = $c->component($class) || $class;
1645     $c->state(0);
1646
1647     if ( $c->depth >= $RECURSION ) {
1648         my $action = $code->reverse();
1649         $action = "/$action" unless $action =~ /->/;
1650         my $error = qq/Deep recursion detected calling "${action}"/;
1651         $c->log->error($error);
1652         $c->error($error);
1653         $c->state(0);
1654         return $c->state;
1655     }
1656
1657     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1658
1659     push( @{ $c->stack }, $code );
1660
1661     no warnings 'recursion';
1662     # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1663     #      I have no idea how, ergo $ret (which appears to fix the issue)
1664     eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
1665
1666     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1667
1668     my $last = pop( @{ $c->stack } );
1669
1670     if ( my $error = $@ ) {
1671         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1672             $error->rethrow if $c->depth > 1;
1673         }
1674         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1675             $error->rethrow if $c->depth > 0;
1676         }
1677         else {
1678             unless ( ref $error ) {
1679                 no warnings 'uninitialized';
1680                 chomp $error;
1681                 my $class = $last->class;
1682                 my $name  = $last->name;
1683                 $error = qq/Caught exception in $class->$name "$error"/;
1684             }
1685             $c->error($error);
1686         }
1687         $c->state(0);
1688     }
1689     return $c->state;
1690 }
1691
1692 sub _stats_start_execute {
1693     my ( $c, $code ) = @_;
1694     my $appclass = ref($c) || $c;
1695     return if ( ( $code->name =~ /^_.*/ )
1696         && ( !$appclass->config->{show_internal_actions} ) );
1697
1698     my $action_name = $code->reverse();
1699     $c->counter->{$action_name}++;
1700
1701     my $action = $action_name;
1702     $action = "/$action" unless $action =~ /->/;
1703
1704     # determine if the call was the result of a forward
1705     # this is done by walking up the call stack and looking for a calling
1706     # sub of Catalyst::forward before the eval
1707     my $callsub = q{};
1708     for my $index ( 2 .. 11 ) {
1709         last
1710         if ( ( caller($index) )[0] eq 'Catalyst'
1711             && ( caller($index) )[3] eq '(eval)' );
1712
1713         if ( ( caller($index) )[3] =~ /forward$/ ) {
1714             $callsub = ( caller($index) )[3];
1715             $action  = "-> $action";
1716             last;
1717         }
1718     }
1719
1720     my $uid = $action_name . $c->counter->{$action_name};
1721
1722     # is this a root-level call or a forwarded call?
1723     if ( $callsub =~ /forward$/ ) {
1724         my $parent = $c->stack->[-1];
1725
1726         # forward, locate the caller
1727         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1728             $c->stats->profile(
1729                 begin  => $action,
1730                 parent => "$parent" . $c->counter->{"$parent"},
1731                 uid    => $uid,
1732             );
1733         }
1734         else {
1735
1736             # forward with no caller may come from a plugin
1737             $c->stats->profile(
1738                 begin => $action,
1739                 uid   => $uid,
1740             );
1741         }
1742     }
1743     else {
1744
1745         # root-level call
1746         $c->stats->profile(
1747             begin => $action,
1748             uid   => $uid,
1749         );
1750     }
1751     return $action;
1752
1753 }
1754
1755 sub _stats_finish_execute {
1756     my ( $c, $info ) = @_;
1757     $c->stats->profile( end => $info );
1758 }
1759
1760 =head2 $c->finalize
1761
1762 Finalizes the request.
1763
1764 =cut
1765
1766 sub finalize {
1767     my $c = shift;
1768
1769     for my $error ( @{ $c->error } ) {
1770         $c->log->error($error);
1771     }
1772
1773     # Allow engine to handle finalize flow (for POE)
1774     my $engine = $c->engine;
1775     if ( my $code = $engine->can('finalize') ) {
1776         $engine->$code($c);
1777     }
1778     else {
1779
1780         $c->finalize_uploads;
1781
1782         # Error
1783         if ( $#{ $c->error } >= 0 ) {
1784             $c->finalize_error;
1785         }
1786
1787         $c->finalize_headers;
1788
1789         # HEAD request
1790         if ( $c->request->method eq 'HEAD' ) {
1791             $c->response->body('');
1792         }
1793
1794         $c->finalize_body;
1795     }
1796
1797     $c->log_response;
1798
1799     if ($c->use_stats) {
1800         my $elapsed = sprintf '%f', $c->stats->elapsed;
1801         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1802         $c->log->info(
1803             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1804     }
1805
1806     return $c->response->status;
1807 }
1808
1809 =head2 $c->finalize_body
1810
1811 Finalizes body.
1812
1813 =cut
1814
1815 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1816
1817 =head2 $c->finalize_cookies
1818
1819 Finalizes cookies.
1820
1821 =cut
1822
1823 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1824
1825 =head2 $c->finalize_error
1826
1827 Finalizes error.
1828
1829 =cut
1830
1831 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1832
1833 =head2 $c->finalize_headers
1834
1835 Finalizes headers.
1836
1837 =cut
1838
1839 sub finalize_headers {
1840     my $c = shift;
1841
1842     my $response = $c->response; #accessor calls can add up?
1843
1844     # Check if we already finalized headers
1845     return if $response->finalized_headers;
1846
1847     # Handle redirects
1848     if ( my $location = $response->redirect ) {
1849         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1850         $response->header( Location => $location );
1851
1852         if ( !$response->has_body ) {
1853             # Add a default body if none is already present
1854             $response->body(
1855                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1856             );
1857         }
1858     }
1859
1860     # Content-Length
1861     if ( defined $response->body && length $response->body && !$response->content_length ) {
1862
1863         # get the length from a filehandle
1864         if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
1865         {
1866             my $stat = stat $response->body;
1867             if ( $stat && $stat->size > 0 ) {
1868                 $response->content_length( $stat->size );
1869             }
1870             else {
1871                 $c->log->warn('Serving filehandle without a content-length');
1872             }
1873         }
1874         else {
1875             # everything should be bytes at this point, but just in case
1876             $response->content_length( length( $response->body ) );
1877         }
1878     }
1879
1880     # Errors
1881     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1882         $response->headers->remove_header("Content-Length");
1883         $response->body('');
1884     }
1885
1886     $c->finalize_cookies;
1887
1888     $c->engine->finalize_headers( $c, @_ );
1889
1890     # Done
1891     $response->finalized_headers(1);
1892 }
1893
1894 =head2 $c->finalize_output
1895
1896 An alias for finalize_body.
1897
1898 =head2 $c->finalize_read
1899
1900 Finalizes the input after reading is complete.
1901
1902 =cut
1903
1904 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1905
1906 =head2 $c->finalize_uploads
1907
1908 Finalizes uploads. Cleans up any temporary files.
1909
1910 =cut
1911
1912 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1913
1914 =head2 $c->get_action( $action, $namespace )
1915
1916 Gets an action in a given namespace.
1917
1918 =cut
1919
1920 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1921
1922 =head2 $c->get_actions( $action, $namespace )
1923
1924 Gets all actions of a given name in a namespace and all parent
1925 namespaces.
1926
1927 =cut
1928
1929 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1930
1931 =head2 $app->handle_request( @arguments )
1932
1933 Called to handle each HTTP request.
1934
1935 =cut
1936
1937 sub handle_request {
1938     my ( $class, @arguments ) = @_;
1939
1940     # Always expect worst case!
1941     my $status = -1;
1942     eval {
1943         if ($class->debug) {
1944             my $secs = time - $START || 1;
1945             my $av = sprintf '%.3f', $COUNT / $secs;
1946             my $time = localtime time;
1947             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1948         }
1949
1950         my $c = $class->prepare(@arguments);
1951         $c->dispatch;
1952         $status = $c->finalize;
1953     };
1954
1955     if ( my $error = $@ ) {
1956         chomp $error;
1957         $class->log->error(qq/Caught exception in engine "$error"/);
1958     }
1959
1960     $COUNT++;
1961
1962     if(my $coderef = $class->log->can('_flush')){
1963         $class->log->$coderef();
1964     }
1965     return $status;
1966 }
1967
1968 =head2 $c->prepare( @arguments )
1969
1970 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1971 etc.).
1972
1973 =cut
1974
1975 sub prepare {
1976     my ( $class, @arguments ) = @_;
1977
1978     # XXX
1979     # After the app/ctxt split, this should become an attribute based on something passed
1980     # into the application.
1981     $class->context_class( ref $class || $class ) unless $class->context_class;
1982
1983     my $c = $class->context_class->new({});
1984
1985     # For on-demand data
1986     $c->request->_context($c);
1987     $c->response->_context($c);
1988
1989     #surely this is not the most efficient way to do things...
1990     $c->stats($class->stats_class->new)->enable($c->use_stats);
1991     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
1992         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1993     }
1994
1995     #XXX reuse coderef from can
1996     # Allow engine to direct the prepare flow (for POE)
1997     if ( $c->engine->can('prepare') ) {
1998         $c->engine->prepare( $c, @arguments );
1999     }
2000     else {
2001         $c->prepare_request(@arguments);
2002         $c->prepare_connection;
2003         $c->prepare_query_parameters;
2004         $c->prepare_headers;
2005         $c->prepare_cookies;
2006         $c->prepare_path;
2007
2008         # Prepare the body for reading, either by prepare_body
2009         # or the user, if they are using $c->read
2010         $c->prepare_read;
2011
2012         # Parse the body unless the user wants it on-demand
2013         unless ( ref($c)->config->{parse_on_demand} ) {
2014             $c->prepare_body;
2015         }
2016     }
2017
2018     my $method  = $c->req->method  || '';
2019     my $path    = $c->req->path;
2020     $path       = '/' unless length $path;
2021     my $address = $c->req->address || '';
2022
2023     $c->log_request;
2024
2025     $c->prepare_action;
2026
2027     return $c;
2028 }
2029
2030 =head2 $c->prepare_action
2031
2032 Prepares action. See L<Catalyst::Dispatcher>.
2033
2034 =cut
2035
2036 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
2037
2038 =head2 $c->prepare_body
2039
2040 Prepares message body.
2041
2042 =cut
2043
2044 sub prepare_body {
2045     my $c = shift;
2046
2047     return if $c->request->_has_body;
2048
2049     # Initialize on-demand data
2050     $c->engine->prepare_body( $c, @_ );
2051     $c->prepare_parameters;
2052     $c->prepare_uploads;
2053 }
2054
2055 =head2 $c->prepare_body_chunk( $chunk )
2056
2057 Prepares a chunk of data before sending it to L<HTTP::Body>.
2058
2059 See L<Catalyst::Engine>.
2060
2061 =cut
2062
2063 sub prepare_body_chunk {
2064     my $c = shift;
2065     $c->engine->prepare_body_chunk( $c, @_ );
2066 }
2067
2068 =head2 $c->prepare_body_parameters
2069
2070 Prepares body parameters.
2071
2072 =cut
2073
2074 sub prepare_body_parameters {
2075     my $c = shift;
2076     $c->engine->prepare_body_parameters( $c, @_ );
2077 }
2078
2079 =head2 $c->prepare_connection
2080
2081 Prepares connection.
2082
2083 =cut
2084
2085 sub prepare_connection {
2086     my $c = shift;
2087     $c->engine->prepare_connection( $c, @_ );
2088 }
2089
2090 =head2 $c->prepare_cookies
2091
2092 Prepares cookies.
2093
2094 =cut
2095
2096 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
2097
2098 =head2 $c->prepare_headers
2099
2100 Prepares headers.
2101
2102 =cut
2103
2104 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
2105
2106 =head2 $c->prepare_parameters
2107
2108 Prepares parameters.
2109
2110 =cut
2111
2112 sub prepare_parameters {
2113     my $c = shift;
2114     $c->prepare_body_parameters;
2115     $c->engine->prepare_parameters( $c, @_ );
2116 }
2117
2118 =head2 $c->prepare_path
2119
2120 Prepares path and base.
2121
2122 =cut
2123
2124 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2125
2126 =head2 $c->prepare_query_parameters
2127
2128 Prepares query parameters.
2129
2130 =cut
2131
2132 sub prepare_query_parameters {
2133     my $c = shift;
2134
2135     $c->engine->prepare_query_parameters( $c, @_ );
2136 }
2137
2138 =head2 $c->log_request
2139
2140 Writes information about the request to the debug logs.  This includes:
2141
2142 =over 4
2143
2144 =item * Request method, path, and remote IP address
2145
2146 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2147
2148 =item * Request parameters
2149
2150 =item * File uploads
2151
2152 =back
2153
2154 =cut
2155
2156 sub log_request {
2157     my $c = shift;
2158
2159     return unless $c->debug;
2160
2161     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2162     my $request = $dump->[1];
2163
2164     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2165     $method ||= '';
2166     $path = '/' unless length $path;
2167     $address ||= '';
2168     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2169
2170     $c->log_request_headers($request->headers);
2171
2172     if ( my $keywords = $request->query_keywords ) {
2173         $c->log->debug("Query keywords are: $keywords");
2174     }
2175
2176     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2177
2178     $c->log_request_uploads($request);
2179 }
2180
2181 =head2 $c->log_response
2182
2183 Writes information about the response to the debug logs by calling
2184 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2185
2186 =cut
2187
2188 sub log_response {
2189     my $c = shift;
2190
2191     return unless $c->debug;
2192
2193     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2194     my $response = $dump->[1];
2195
2196     $c->log_response_status_line($response);
2197     $c->log_response_headers($response->headers);
2198 }
2199
2200 =head2 $c->log_response_status_line($response)
2201
2202 Writes one line of information about the response to the debug logs.  This includes:
2203
2204 =over 4
2205
2206 =item * Response status code
2207
2208 =item * Content-Type header (if present)
2209
2210 =item * Content-Length header (if present)
2211
2212 =back
2213
2214 =cut
2215
2216 sub log_response_status_line {
2217     my ($c, $response) = @_;
2218
2219     $c->log->debug(
2220         sprintf(
2221             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2222             $response->status                            || 'unknown',
2223             $response->headers->header('Content-Type')   || 'unknown',
2224             $response->headers->header('Content-Length') || 'unknown'
2225         )
2226     );
2227 }
2228
2229 =head2 $c->log_response_headers($headers);
2230
2231 Hook method which can be wrapped by plugins to log the responseheaders.
2232 No-op in the default implementation.
2233
2234 =cut
2235
2236 sub log_response_headers {}
2237
2238 =head2 $c->log_request_parameters( query => {}, body => {} )
2239
2240 Logs request parameters to debug logs
2241
2242 =cut
2243
2244 sub log_request_parameters {
2245     my $c          = shift;
2246     my %all_params = @_;
2247
2248     return unless $c->debug;
2249
2250     my $column_width = Catalyst::Utils::term_width() - 44;
2251     foreach my $type (qw(query body)) {
2252         my $params = $all_params{$type};
2253         next if ! keys %$params;
2254         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2255         for my $key ( sort keys %$params ) {
2256             my $param = $params->{$key};
2257             my $value = defined($param) ? $param : '';
2258             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2259         }
2260         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2261     }
2262 }
2263
2264 =head2 $c->log_request_uploads
2265
2266 Logs file uploads included in the request to the debug logs.
2267 The parameter name, filename, file type, and file size are all included in
2268 the debug logs.
2269
2270 =cut
2271
2272 sub log_request_uploads {
2273     my $c = shift;
2274     my $request = shift;
2275     return unless $c->debug;
2276     my $uploads = $request->uploads;
2277     if ( keys %$uploads ) {
2278         my $t = Text::SimpleTable->new(
2279             [ 12, 'Parameter' ],
2280             [ 26, 'Filename' ],
2281             [ 18, 'Type' ],
2282             [ 9,  'Size' ]
2283         );
2284         for my $key ( sort keys %$uploads ) {
2285             my $upload = $uploads->{$key};
2286             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2287                 $t->row( $key, $u->filename, $u->type, $u->size );
2288             }
2289         }
2290         $c->log->debug( "File Uploads are:\n" . $t->draw );
2291     }
2292 }
2293
2294 =head2 $c->log_request_headers($headers);
2295
2296 Hook method which can be wrapped by plugins to log the request headers.
2297 No-op in the default implementation.
2298
2299 =cut
2300
2301 sub log_request_headers {}
2302
2303 =head2 $c->log_headers($type => $headers)
2304
2305 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2306
2307 =cut
2308
2309 sub log_headers {
2310     my $c       = shift;
2311     my $type    = shift;
2312     my $headers = shift;    # an HTTP::Headers instance
2313
2314     return unless $c->debug;
2315
2316     my $column_width = Catalyst::Utils::term_width() - 28;
2317     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2318     $headers->scan(
2319         sub {
2320             my ( $name, $value ) = @_;
2321             $t->row( $name, $value );
2322         }
2323     );
2324     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2325 }
2326
2327
2328 =head2 $c->prepare_read
2329
2330 Prepares the input for reading.
2331
2332 =cut
2333
2334 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2335
2336 =head2 $c->prepare_request
2337
2338 Prepares the engine request.
2339
2340 =cut
2341
2342 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2343
2344 =head2 $c->prepare_uploads
2345
2346 Prepares uploads.
2347
2348 =cut
2349
2350 sub prepare_uploads {
2351     my $c = shift;
2352
2353     $c->engine->prepare_uploads( $c, @_ );
2354 }
2355
2356 =head2 $c->prepare_write
2357
2358 Prepares the output for writing.
2359
2360 =cut
2361
2362 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2363
2364 =head2 $c->request_class
2365
2366 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2367
2368 =head2 $c->response_class
2369
2370 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2371
2372 =head2 $c->read( [$maxlength] )
2373
2374 Reads a chunk of data from the request body. This method is designed to
2375 be used in a while loop, reading C<$maxlength> bytes on every call.
2376 C<$maxlength> defaults to the size of the request if not specified.
2377
2378 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2379 directly.
2380
2381 Warning: If you use read(), Catalyst will not process the body,
2382 so you will not be able to access POST parameters or file uploads via
2383 $c->request.  You must handle all body parsing yourself.
2384
2385 =cut
2386
2387 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2388
2389 =head2 $c->run
2390
2391 Starts the engine.
2392
2393 =cut
2394
2395 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2396
2397 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2398
2399 Sets an action in a given namespace.
2400
2401 =cut
2402
2403 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2404
2405 =head2 $c->setup_actions($component)
2406
2407 Sets up actions for a component.
2408
2409 =cut
2410
2411 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2412
2413 =head2 $c->setup_config
2414
2415 =cut
2416
2417 sub setup_config {
2418     my $class = shift;
2419
2420     my %args = %{ $class->config || {} };
2421
2422     my @container_classes = ( "${class}::Container", 'Catalyst::Container');
2423     unshift @container_classes, delete $args{container_class} if exists $args{container_class};
2424
2425     my $container_class = Class::MOP::load_first_existing_class(@container_classes);
2426
2427     my $container = $container_class->new( %args, name => "$class" );
2428     $class->container($container);
2429
2430     my $config = $container->resolve(service => 'config');
2431     $class->config($config);
2432     $class->finalize_config; # back-compat
2433 }
2434
2435 =head $c->finalize_config
2436
2437 =cut
2438
2439 sub finalize_config { }
2440
2441 =head2 $c->setup_components
2442
2443 This method is called internally to set up the application's components.
2444
2445 It finds modules by calling the L<locate_components> method, expands them to
2446 package names with the L<expand_component_module> method, and then installs
2447 each component into the application.
2448
2449 The C<setup_components> config option is passed to both of the above methods.
2450
2451 Installation of each component is performed by the L<setup_component> method,
2452 below.
2453
2454 =cut
2455
2456 sub setup_components {
2457     my $class = shift;
2458
2459     my $config  = $class->config->{ setup_components };
2460
2461     my @comps = $class->locate_components($config);
2462     my %comps = map { $_ => 1 } @comps;
2463
2464     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2465     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2466         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2467     ) if $deprecatedcatalyst_component_names;
2468
2469     for my $component ( @comps ) {
2470
2471         # We pass ignore_loaded here so that overlay files for (e.g.)
2472         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2473         # we know M::P::O found a file on disk so this is safe
2474
2475         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2476     }
2477
2478     my $containers;
2479     $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
2480
2481     for my $component (@comps) {
2482         my $instance = $class->components->{ $component } = $class->setup_component($component);
2483         if ( my ($type, $name) = _get_component_type_name($component) ) {
2484             $containers->{$type}->add_service(Catalyst::BlockInjection->new( name => $name, block => sub { return $instance } ));
2485         }
2486         my @expanded_components = $instance->can('expand_modules')
2487             ? $instance->expand_modules( $component, $config )
2488             : $class->expand_component_module( $component, $config );
2489         for my $component (@expanded_components) {
2490             next if $comps{$component};
2491
2492             $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components;
2493             $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2494                 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2495             ) if $deprecatedcatalyst_component_names;
2496
2497             if (my ($type, $name) = _get_component_type_name($component)) {
2498                 $containers->{$type}->add_service(Catalyst::BlockInjection->new( name => $name, block => sub { return $class->setup_component($component) } ));
2499             }
2500
2501             $class->components->{ $component } = $class->setup_component($component);
2502         }
2503     }
2504 }
2505
2506 sub _get_component_type_name {
2507     my $component = shift;
2508     my @parts     = split /::/, $component;
2509
2510     while (my $type = shift @parts) {
2511         return ('controller', join '::', @parts)
2512             if $type =~ /^(c|controller)$/i;
2513
2514         return ('model', join '::', @parts)
2515             if $type =~ /^(m|model)$/i;
2516
2517         return ('view', join '::', @parts)
2518             if $type =~ /^(v|view)$/i;
2519     }
2520 }
2521
2522 =head2 $c->locate_components( $setup_component_config )
2523
2524 This method is meant to provide a list of component modules that should be
2525 setup for the application.  By default, it will use L<Module::Pluggable>.
2526
2527 Specify a C<setup_components> config option to pass additional options directly
2528 to L<Module::Pluggable>. To add additional search paths, specify a key named
2529 C<search_extra> as an array reference. Items in the array beginning with C<::>
2530 will have the application class name prepended to them.
2531
2532 =cut
2533
2534 sub locate_components {
2535     my $class  = shift;
2536     my $config = shift;
2537
2538     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2539     my $extra   = delete $config->{ search_extra } || [];
2540
2541     push @paths, @$extra;
2542
2543     my $locator = Module::Pluggable::Object->new(
2544         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2545         %$config
2546     );
2547
2548     # XXX think about ditching this sort entirely
2549     my @comps = sort { length $a <=> length $b } $locator->plugins;
2550
2551     return @comps;
2552 }
2553
2554 =head2 $c->expand_component_module( $component, $setup_component_config )
2555
2556 Components found by C<locate_components> will be passed to this method, which
2557 is expected to return a list of component (package) names to be set up.
2558
2559 =cut
2560
2561 sub expand_component_module {
2562     my ($class, $module) = @_;
2563     return Devel::InnerPackage::list_packages( $module );
2564 }
2565
2566 =head2 $c->setup_component
2567
2568 =cut
2569
2570 sub setup_component {
2571     my( $class, $component ) = @_;
2572
2573     unless ( $component->can( 'COMPONENT' ) ) {
2574         return $component;
2575     }
2576
2577     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2578     my $config = $class->config->{ $suffix } || {};
2579     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2580     # methods also pass it. local to avoid pointlessly shitting in config
2581     # for the debug screen, as $component is already the key name.
2582     local $config->{catalyst_component_name} = $component;
2583
2584     my $instance = eval { $component->COMPONENT( $class, $config ); };
2585
2586     if ( my $error = $@ ) {
2587         chomp $error;
2588         Catalyst::Exception->throw(
2589             message => qq/Couldn't instantiate component "$component", "$error"/
2590         );
2591     }
2592     elsif (!blessed $instance) {
2593         my $metaclass = Moose::Util::find_meta($component);
2594         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2595         my $component_method_from = $method_meta->associated_metaclass->name;
2596         my $value = defined($instance) ? $instance : 'undef';
2597         Catalyst::Exception->throw(
2598             message =>
2599             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2600         );
2601     }
2602
2603     return $instance;
2604 }
2605
2606 =head2 $c->setup_dispatcher
2607
2608 Sets up dispatcher.
2609
2610 =cut
2611
2612 sub setup_dispatcher {
2613     my ( $class, $dispatcher ) = @_;
2614
2615     if ($dispatcher) {
2616         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2617     }
2618
2619     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2620         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2621     }
2622
2623     unless ($dispatcher) {
2624         $dispatcher = $class->dispatcher_class;
2625     }
2626
2627     Class::MOP::load_class($dispatcher);
2628
2629     # dispatcher instance
2630     $class->dispatcher( $dispatcher->new );
2631 }
2632
2633 =head2 $c->setup_engine
2634
2635 Sets up engine.
2636
2637 =cut
2638
2639 sub setup_engine {
2640     my ( $class, $engine ) = @_;
2641
2642     if ($engine) {
2643         $engine = 'Catalyst::Engine::' . $engine;
2644     }
2645
2646     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2647         $engine = 'Catalyst::Engine::' . $env;
2648     }
2649
2650     if ( $ENV{MOD_PERL} ) {
2651         my $meta = Class::MOP::get_metaclass_by_name($class);
2652
2653         # create the apache method
2654         $meta->add_method('apache' => sub { shift->engine->apache });
2655
2656         my ( $software, $version ) =
2657           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2658
2659         $version =~ s/_//g;
2660         $version =~ s/(\.[^.]+)\./$1/g;
2661
2662         if ( $software eq 'mod_perl' ) {
2663
2664             if ( !$engine ) {
2665
2666                 if ( $version >= 1.99922 ) {
2667                     $engine = 'Catalyst::Engine::Apache2::MP20';
2668                 }
2669
2670                 elsif ( $version >= 1.9901 ) {
2671                     $engine = 'Catalyst::Engine::Apache2::MP19';
2672                 }
2673
2674                 elsif ( $version >= 1.24 ) {
2675                     $engine = 'Catalyst::Engine::Apache::MP13';
2676                 }
2677
2678                 else {
2679                     Catalyst::Exception->throw( message =>
2680                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2681                 }
2682
2683             }
2684
2685             # install the correct mod_perl handler
2686             if ( $version >= 1.9901 ) {
2687                 *handler = sub  : method {
2688                     shift->handle_request(@_);
2689                 };
2690             }
2691             else {
2692                 *handler = sub ($$) { shift->handle_request(@_) };
2693             }
2694
2695         }
2696
2697         elsif ( $software eq 'Zeus-Perl' ) {
2698             $engine = 'Catalyst::Engine::Zeus';
2699         }
2700
2701         else {
2702             Catalyst::Exception->throw(
2703                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2704         }
2705     }
2706
2707     unless ($engine) {
2708         $engine = $class->engine_class;
2709     }
2710
2711     Class::MOP::load_class($engine);
2712
2713     # check for old engines that are no longer compatible
2714     my $old_engine;
2715     if ( $engine->isa('Catalyst::Engine::Apache')
2716         && !Catalyst::Engine::Apache->VERSION )
2717     {
2718         $old_engine = 1;
2719     }
2720
2721     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2722         && Catalyst::Engine::Server->VERSION le '0.02' )
2723     {
2724         $old_engine = 1;
2725     }
2726
2727     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2728         && $engine->VERSION eq '0.01' )
2729     {
2730         $old_engine = 1;
2731     }
2732
2733     elsif ($engine->isa('Catalyst::Engine::Zeus')
2734         && $engine->VERSION eq '0.01' )
2735     {
2736         $old_engine = 1;
2737     }
2738
2739     if ($old_engine) {
2740         Catalyst::Exception->throw( message =>
2741               qq/Engine "$engine" is not supported by this version of Catalyst/
2742         );
2743     }
2744
2745     # engine instance
2746     $class->engine( $engine->new );
2747 }
2748
2749 =head2 $c->setup_home
2750
2751 Sets up the home directory.
2752
2753 =cut
2754
2755 sub setup_home {
2756     my ( $class, $home ) = @_;
2757
2758     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2759         $home = $env;
2760     }
2761
2762     $home ||= Catalyst::Utils::home($class);
2763
2764     if ($home) {
2765         #I remember recently being scolded for assigning config values like this
2766         $class->config->{home} ||= $home;
2767         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2768     }
2769 }
2770
2771 =head2 $c->setup_log
2772
2773 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2774 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2775 log to.
2776
2777 This method also installs a C<debug> method that returns a true value into the
2778 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2779 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2780
2781 Note that if the log has already been setup, by either a previous call to
2782 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2783 that this method won't actually set up the log object.
2784
2785 =cut
2786
2787 sub setup_log {
2788     my ( $class, $levels ) = @_;
2789
2790     $levels ||= '';
2791     $levels =~ s/^\s+//;
2792     $levels =~ s/\s+$//;
2793     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2794
2795     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2796     if ( defined $env_debug ) {
2797         $levels{debug} = 1 if $env_debug; # Ugly!
2798         delete($levels{debug}) unless $env_debug;
2799     }
2800
2801     unless ( $class->log ) {
2802         $class->log( Catalyst::Log->new(keys %levels) );
2803     }
2804
2805     if ( $levels{debug} ) {
2806         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2807         $class->log->debug('Debug messages enabled');
2808     }
2809 }
2810
2811 =head2 $c->setup_plugins
2812
2813 Sets up plugins.
2814
2815 =cut
2816
2817 =head2 $c->setup_stats
2818
2819 Sets up timing statistics class.
2820
2821 =cut
2822
2823 sub setup_stats {
2824     my ( $class, $stats ) = @_;
2825
2826     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2827
2828     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2829     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2830         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2831         $class->log->debug('Statistics enabled');
2832     }
2833 }
2834
2835
2836 =head2 $c->registered_plugins
2837
2838 Returns a sorted list of the plugins which have either been stated in the
2839 import list or which have been added via C<< MyApp->plugin(@args); >>.
2840
2841 If passed a given plugin name, it will report a boolean value indicating
2842 whether or not that plugin is loaded.  A fully qualified name is required if
2843 the plugin name does not begin with C<Catalyst::Plugin::>.
2844
2845  if ($c->registered_plugins('Some::Plugin')) {
2846      ...
2847  }
2848
2849 =cut
2850
2851 {
2852
2853     sub registered_plugins {
2854         my $proto = shift;
2855         return sort keys %{ $proto->_plugins } unless @_;
2856         my $plugin = shift;
2857         return 1 if exists $proto->_plugins->{$plugin};
2858         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2859     }
2860
2861     sub _register_plugin {
2862         my ( $proto, $plugin, $instant ) = @_;
2863         my $class = ref $proto || $proto;
2864
2865         Class::MOP::load_class( $plugin );
2866         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
2867             if $plugin->isa( 'Catalyst::Component' );
2868         $proto->_plugins->{$plugin} = 1;
2869         unless ($instant) {
2870             my $meta = Class::MOP::get_metaclass_by_name($class);
2871             $meta->superclasses($plugin, $meta->superclasses);
2872         }
2873         return $class;
2874     }
2875
2876     sub setup_plugins {
2877         my ( $class, $plugins ) = @_;
2878
2879         $class->_plugins( {} ) unless $class->_plugins;
2880         $plugins = Data::OptList::mkopt($plugins || []);
2881
2882         my @plugins = map {
2883             [ Catalyst::Utils::resolve_namespace(
2884                   $class . '::Plugin',
2885                   'Catalyst::Plugin', $_->[0]
2886               ),
2887               $_->[1],
2888             ]
2889          } @{ $plugins };
2890
2891         for my $plugin ( reverse @plugins ) {
2892             Class::MOP::load_class($plugin->[0], $plugin->[1]);
2893             my $meta = find_meta($plugin->[0]);
2894             next if $meta && $meta->isa('Moose::Meta::Role');
2895
2896             $class->_register_plugin($plugin->[0]);
2897         }
2898
2899         my @roles =
2900             map  { $_->[0]->name, $_->[1] }
2901             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
2902             map  { [find_meta($_->[0]), $_->[1]] }
2903             @plugins;
2904
2905         Moose::Util::apply_all_roles(
2906             $class => @roles
2907         ) if @roles;
2908     }
2909 }
2910
2911 =head2 $c->stack
2912
2913 Returns an arrayref of the internal execution stack (actions that are
2914 currently executing).
2915
2916 =head2 $c->stats
2917
2918 Returns the current timing statistics object. By default Catalyst uses
2919 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
2920 L<< stats_class|/"$c->stats_class" >>.
2921
2922 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
2923 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
2924 profile explicitly, although MyApp.pm still won't profile nor output anything
2925 by itself.
2926
2927 =head2 $c->stats_class
2928
2929 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
2930
2931 =head2 $c->use_stats
2932
2933 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
2934
2935 Note that this is a static method, not an accessor and should be overridden
2936 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2937
2938 =cut
2939
2940 sub use_stats { 0 }
2941
2942
2943 =head2 $c->write( $data )
2944
2945 Writes $data to the output stream. When using this method directly, you
2946 will need to manually set the C<Content-Length> header to the length of
2947 your output data, if known.
2948
2949 =cut
2950
2951 sub write {
2952     my $c = shift;
2953
2954     # Finalize headers if someone manually writes output
2955     $c->finalize_headers;
2956
2957     return $c->engine->write( $c, @_ );
2958 }
2959
2960 =head2 version
2961
2962 Returns the Catalyst version number. Mostly useful for "powered by"
2963 messages in template systems.
2964
2965 =cut
2966
2967 sub version { return $Catalyst::VERSION }
2968
2969 =head1 CONFIGURATION
2970
2971 There are a number of 'base' config variables which can be set:
2972
2973 =over
2974
2975 =item *
2976
2977 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
2978
2979 =item *
2980
2981 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
2982
2983 =item *
2984
2985 C<disable_component_resolution_regex_fallback> - Turns
2986 off the deprecated component resolution functionality so
2987 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
2988 are called then regex search will not be attempted on string values and
2989 instead C<undef> will be returned.
2990
2991 =item *
2992
2993 C<home> - The application home directory. In an uninstalled application,
2994 this is the top level application directory. In an installed application,
2995 this will be the directory containing C<< MyApp.pm >>.
2996
2997 =item *
2998
2999 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3000
3001 =item *
3002
3003 C<name> - The name of the application in debug messages and the debug and
3004 welcome screens
3005
3006 =item *
3007
3008 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3009 until it is accessed. This allows you to (for example) check authentication (and reject
3010 the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
3011
3012 =item *
3013
3014 C<root> - The root directory for templates. Usually this is just a
3015 subdirectory of the home directory, but you can set it to change the
3016 templates to a different directory.
3017
3018 =item *
3019
3020 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3021 namespaces from which components will be loaded (and constructed and stored in
3022 C<< $c->components >>).
3023
3024 =item *
3025
3026 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3027 to be shown in hit debug tables in the test server.
3028
3029 =item *
3030
3031 C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
3032 variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
3033 for more information.
3034
3035 =item *
3036
3037 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3038
3039 =back
3040
3041 =head1 INTERNAL ACTIONS
3042
3043 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3044 C<_ACTION>, and C<_END>. These are by default not shown in the private
3045 action table, but you can make them visible with a config parameter.
3046
3047     MyApp->config(show_internal_actions => 1);
3048
3049 =head1 ON-DEMAND PARSER
3050
3051 The request body is usually parsed at the beginning of a request,
3052 but if you want to handle input yourself, you can enable on-demand
3053 parsing with a config parameter.
3054
3055     MyApp->config(parse_on_demand => 1);
3056
3057 =head1 PROXY SUPPORT
3058
3059 Many production servers operate using the common double-server approach,
3060 with a lightweight frontend web server passing requests to a larger
3061 backend server. An application running on the backend server must deal
3062 with two problems: the remote user always appears to be C<127.0.0.1> and
3063 the server's hostname will appear to be C<localhost> regardless of the
3064 virtual host that the user connected through.
3065
3066 Catalyst will automatically detect this situation when you are running
3067 the frontend and backend servers on the same machine. The following
3068 changes are made to the request.
3069
3070     $c->req->address is set to the user's real IP address, as read from
3071     the HTTP X-Forwarded-For header.
3072
3073     The host value for $c->req->base and $c->req->uri is set to the real
3074     host, as read from the HTTP X-Forwarded-Host header.
3075
3076 Additionally, you may be running your backend application on an insecure
3077 connection (port 80) while your frontend proxy is running under SSL.  If there
3078 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3079 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3080 be created properly.
3081
3082 In the case of passing in:
3083
3084     X-Forwarded-Port: 443
3085
3086 All calls to C<uri_for> will result in an https link, as is expected.
3087
3088 Obviously, your web server must support these headers for this to work.
3089
3090 In a more complex server farm environment where you may have your
3091 frontend proxy server(s) on different machines, you will need to set a
3092 configuration option to tell Catalyst to read the proxied data from the
3093 headers.
3094
3095     MyApp->config(using_frontend_proxy => 1);
3096
3097 If you do not wish to use the proxy support at all, you may set:
3098
3099     MyApp->config(ignore_frontend_proxy => 1);
3100
3101 =head1 THREAD SAFETY
3102
3103 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3104 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3105 believe the Catalyst core to be thread-safe.
3106
3107 If you plan to operate in a threaded environment, remember that all other
3108 modules you are using must also be thread-safe. Some modules, most notably
3109 L<DBD::SQLite>, are not thread-safe.
3110
3111 =head1 SUPPORT
3112
3113 IRC:
3114
3115     Join #catalyst on irc.perl.org.
3116
3117 Mailing Lists:
3118
3119     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
3120     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
3121
3122 Web:
3123
3124     http://catalyst.perl.org
3125
3126 Wiki:
3127
3128     http://dev.catalyst.perl.org
3129
3130 =head1 SEE ALSO
3131
3132 =head2 L<Task::Catalyst> - All you need to start with Catalyst
3133
3134 =head2 L<Catalyst::Manual> - The Catalyst Manual
3135
3136 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
3137
3138 =head2 L<Catalyst::Engine> - Core engine
3139
3140 =head2 L<Catalyst::Log> - Log class.
3141
3142 =head2 L<Catalyst::Request> - Request object
3143
3144 =head2 L<Catalyst::Response> - Response object
3145
3146 =head2 L<Catalyst::Test> - The test suite.
3147
3148 =head1 PROJECT FOUNDER
3149
3150 sri: Sebastian Riedel <sri@cpan.org>
3151
3152 =head1 CONTRIBUTORS
3153
3154 abw: Andy Wardley
3155
3156 acme: Leon Brocard <leon@astray.com>
3157
3158 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
3159
3160 Andrew Bramble
3161
3162 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
3163
3164 Andrew Ruthven
3165
3166 andyg: Andy Grundman <andy@hybridized.org>
3167
3168 audreyt: Audrey Tang
3169
3170 bricas: Brian Cassidy <bricas@cpan.org>
3171
3172 Caelum: Rafael Kitover <rkitover@io.com>
3173
3174 chansen: Christian Hansen
3175
3176 chicks: Christopher Hicks
3177
3178 Chisel Wright C<pause@herlpacker.co.uk>
3179
3180 Danijel Milicevic C<me@danijel.de>
3181
3182 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
3183
3184 David Naughton, C<naughton@umn.edu>
3185
3186 David E. Wheeler
3187
3188 dhoss: Devin Austin <dhoss@cpan.org>
3189
3190 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
3191
3192 Drew Taylor
3193
3194 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
3195
3196 esskar: Sascha Kiefer
3197
3198 fireartist: Carl Franks <cfranks@cpan.org>
3199
3200 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
3201
3202 gabb: Danijel Milicevic
3203
3204 Gary Ashton Jones
3205
3206 Gavin Henry C<ghenry@perl.me.uk>
3207
3208 Geoff Richards
3209
3210 groditi: Guillermo Roditi <groditi@gmail.com>
3211
3212 hobbs: Andrew Rodland <andrew@cleverdomain.org>
3213
3214 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
3215
3216 jcamacho: Juan Camacho
3217
3218 jester: Jesse Sheidlower C<jester@panix.com>
3219
3220 jhannah: Jay Hannah <jay@jays.net>
3221
3222 Jody Belka
3223
3224 Johan Lindstrom
3225
3226 jon: Jon Schutz <jjschutz@cpan.org>
3227
3228 Jonathan Rockway C<< <jrockway@cpan.org> >>
3229
3230 Kieren Diment C<kd@totaldatasolution.com>
3231
3232 konobi: Scott McWhirter <konobi@cpan.org>
3233
3234 marcus: Marcus Ramberg <mramberg@cpan.org>
3235
3236 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
3237
3238 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
3239
3240 mugwump: Sam Vilain
3241
3242 naughton: David Naughton
3243
3244 ningu: David Kamholz <dkamholz@cpan.org>
3245
3246 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
3247
3248 numa: Dan Sully <daniel@cpan.org>
3249
3250 obra: Jesse Vincent
3251
3252 Octavian Rasnita
3253
3254 omega: Andreas Marienborg
3255
3256 Oleg Kostyuk <cub.uanic@gmail.com>
3257
3258 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
3259
3260 rafl: Florian Ragwitz <rafl@debian.org>
3261
3262 random: Roland Lammel <lammel@cpan.org>
3263
3264 Robert Sedlacek C<< <rs@474.at> >>
3265
3266 SpiceMan: Marcel Montes
3267
3268 sky: Arthur Bergman
3269
3270 szbalint: Balint Szilakszi <szbalint@cpan.org>
3271
3272 t0m: Tomas Doran <bobtfish@bobtfish.net>
3273
3274 Ulf Edvinsson
3275
3276 Viljo Marrandi C<vilts@yahoo.com>
3277
3278 Will Hawes C<info@whawes.co.uk>
3279
3280 willert: Sebastian Willert <willert@cpan.org>
3281
3282 wreis: Wallace Reis <wallace@reis.org.br>
3283
3284 Yuval Kogman, C<nothingmuch@woobling.org>
3285
3286 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
3287
3288 dd070: Dhaval Dhanani <dhaval070@gmail.com>
3289
3290 =head1 COPYRIGHT
3291
3292 Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
3293
3294 =head1 LICENSE
3295
3296 This library is free software. You can redistribute it and/or modify it under
3297 the same terms as Perl itself.
3298
3299 =cut
3300
3301 no Moose;
3302
3303 __PACKAGE__->meta->make_immutable;
3304
3305 1;