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