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