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