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