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