lib/Catalyst.pm

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