lib/Catalyst.pm

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