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