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