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.80011';
  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     my %comps = map { $_ => 1 } @comps;
2157
2158     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2159     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2160         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2161     ) if $deprecatedcatalyst_component_names;
2162
2163     for my $component ( @comps ) {
2164
2165         # We pass ignore_loaded here so that overlay files for (e.g.)
2166         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2167         # we know M::P::O found a file on disk so this is safe
2168
2169         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2170
2171         # Needs to be done as soon as the component is loaded, as loading a sub-component
2172         # (next time round the loop) can cause us to get the wrong metaclass..
2173         $class->_controller_init_base_classes($component);
2174     }
2175
2176     for my $component (@comps) {
2177         $class->components->{ $component } = $class->setup_component($component);
2178         for my $component ($class->expand_component_module( $component, $config )) {
2179             next if $comps{$component};
2180             $class->_controller_init_base_classes($component); # Also cover inner packages
2181             $class->components->{ $component } = $class->setup_component($component);
2182         }
2183     }
2184 }
2185
2186 =head2 $c->locate_components( $setup_component_config )
2187
2188 This method is meant to provide a list of component modules that should be
2189 setup for the application.  By default, it will use L<Module::Pluggable>.
2190
2191 Specify a C<setup_components> config option to pass additional options directly
2192 to L<Module::Pluggable>. To add additional search paths, specify a key named
2193 C<search_extra> as an array reference. Items in the array beginning with C<::>
2194 will have the application class name prepended to them.
2195
2196 =cut
2197
2198 sub locate_components {
2199     my $class  = shift;
2200     my $config = shift;
2201
2202     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2203     my $extra   = delete $config->{ search_extra } || [];
2204
2205     push @paths, @$extra;
2206
2207     my $locator = Module::Pluggable::Object->new(
2208         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2209         %$config
2210     );
2211
2212     my @comps = $locator->plugins;
2213
2214     return @comps;
2215 }
2216
2217 =head2 $c->expand_component_module( $component, $setup_component_config )
2218
2219 Components found by C<locate_components> will be passed to this method, which
2220 is expected to return a list of component (package) names to be set up.
2221
2222 =cut
2223
2224 sub expand_component_module {
2225     my ($class, $module) = @_;
2226     return Devel::InnerPackage::list_packages( $module );
2227 }
2228
2229 =head2 $c->setup_component
2230
2231 =cut
2232
2233 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2234 #         nearest to Catalyst::Controller first, no matter what order stuff happens
2235 #         to be loaded. There are TODO tests in Moose for this, see
2236 #         f2391d17574eff81d911b97be15ea51080500003
2237 sub _controller_init_base_classes {
2238     my ($app_class, $component) = @_;
2239     return unless $component->isa('Catalyst::Controller');
2240     foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
2241         Moose::Meta::Class->initialize( $class )
2242             unless find_meta($class);
2243     }
2244 }
2245
2246 sub setup_component {
2247     my( $class, $component ) = @_;
2248
2249     unless ( $component->can( 'COMPONENT' ) ) {
2250         return $component;
2251     }
2252
2253     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2254     my $config = $class->config->{ $suffix } || {};
2255     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2256     # methods also pass it. local to avoid pointlessly shitting in config
2257     # for the debug screen, as $component is already the key name.
2258     local $config->{catalyst_component_name} = $component;
2259
2260     my $instance = eval { $component->COMPONENT( $class, $config ); };
2261
2262     if ( my $error = $@ ) {
2263         chomp $error;
2264         Catalyst::Exception->throw(
2265             message => qq/Couldn't instantiate component "$component", "$error"/
2266         );
2267     }
2268
2269     unless (blessed $instance) {
2270         my $metaclass = Moose::Util::find_meta($component);
2271         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2272         my $component_method_from = $method_meta->associated_metaclass->name;
2273         my $value = defined($instance) ? $instance : 'undef';
2274         Catalyst::Exception->throw(
2275             message =>
2276             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2277         );
2278     }
2279     return $instance;
2280 }
2281
2282 =head2 $c->setup_dispatcher
2283
2284 Sets up dispatcher.
2285
2286 =cut
2287
2288 sub setup_dispatcher {
2289     my ( $class, $dispatcher ) = @_;
2290
2291     if ($dispatcher) {
2292         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2293     }
2294
2295     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2296         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2297     }
2298
2299     unless ($dispatcher) {
2300         $dispatcher = $class->dispatcher_class;
2301     }
2302
2303     Class::MOP::load_class($dispatcher);
2304
2305     # dispatcher instance
2306     $class->dispatcher( $dispatcher->new );
2307 }
2308
2309 =head2 $c->setup_engine
2310
2311 Sets up engine.
2312
2313 =cut
2314
2315 sub setup_engine {
2316     my ( $class, $engine ) = @_;
2317
2318     if ($engine) {
2319         $engine = 'Catalyst::Engine::' . $engine;
2320     }
2321
2322     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2323         $engine = 'Catalyst::Engine::' . $env;
2324     }
2325
2326     if ( $ENV{MOD_PERL} ) {
2327         my $meta = Class::MOP::get_metaclass_by_name($class);
2328
2329         # create the apache method
2330         $meta->add_method('apache' => sub { shift->engine->apache });
2331
2332         my ( $software, $version ) =
2333           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2334
2335         $version =~ s/_//g;
2336         $version =~ s/(\.[^.]+)\./$1/g;
2337
2338         if ( $software eq 'mod_perl' ) {
2339
2340             if ( !$engine ) {
2341
2342                 if ( $version >= 1.99922 ) {
2343                     $engine = 'Catalyst::Engine::Apache2::MP20';
2344                 }
2345
2346                 elsif ( $version >= 1.9901 ) {
2347                     $engine = 'Catalyst::Engine::Apache2::MP19';
2348                 }
2349
2350                 elsif ( $version >= 1.24 ) {
2351                     $engine = 'Catalyst::Engine::Apache::MP13';
2352                 }
2353
2354                 else {
2355                     Catalyst::Exception->throw( message =>
2356                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2357                 }
2358
2359             }
2360
2361             # install the correct mod_perl handler
2362             if ( $version >= 1.9901 ) {
2363                 *handler = sub  : method {
2364                     shift->handle_request(@_);
2365                 };
2366             }
2367             else {
2368                 *handler = sub ($$) { shift->handle_request(@_) };
2369             }
2370
2371         }
2372
2373         elsif ( $software eq 'Zeus-Perl' ) {
2374             $engine = 'Catalyst::Engine::Zeus';
2375         }
2376
2377         else {
2378             Catalyst::Exception->throw(
2379                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2380         }
2381     }
2382
2383     unless ($engine) {
2384         $engine = $class->engine_class;
2385     }
2386
2387     Class::MOP::load_class($engine);
2388
2389     # check for old engines that are no longer compatible
2390     my $old_engine;
2391     if ( $engine->isa('Catalyst::Engine::Apache')
2392         && !Catalyst::Engine::Apache->VERSION )
2393     {
2394         $old_engine = 1;
2395     }
2396
2397     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2398         && Catalyst::Engine::Server->VERSION le '0.02' )
2399     {
2400         $old_engine = 1;
2401     }
2402
2403     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2404         && $engine->VERSION eq '0.01' )
2405     {
2406         $old_engine = 1;
2407     }
2408
2409     elsif ($engine->isa('Catalyst::Engine::Zeus')
2410         && $engine->VERSION eq '0.01' )
2411     {
2412         $old_engine = 1;
2413     }
2414
2415     if ($old_engine) {
2416         Catalyst::Exception->throw( message =>
2417               qq/Engine "$engine" is not supported by this version of Catalyst/
2418         );
2419     }
2420
2421     # engine instance
2422     $class->engine( $engine->new );
2423 }
2424
2425 =head2 $c->setup_home
2426
2427 Sets up the home directory.
2428
2429 =cut
2430
2431 sub setup_home {
2432     my ( $class, $home ) = @_;
2433
2434     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2435         $home = $env;
2436     }
2437
2438     $home ||= Catalyst::Utils::home($class);
2439
2440     if ($home) {
2441         #I remember recently being scolded for assigning config values like this
2442         $class->config->{home} ||= $home;
2443         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2444     }
2445 }
2446
2447 =head2 $c->setup_log
2448
2449 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2450 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2451 log to.
2452
2453 This method also installs a C<debug> method that returns a true value into the
2454 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2455 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2456
2457 Note that if the log has already been setup, by either a previous call to
2458 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2459 that this method won't actually set up the log object.
2460
2461 =cut
2462
2463 sub setup_log {
2464     my ( $class, $levels ) = @_;
2465
2466     $levels ||= '';
2467     $levels =~ s/^\s+//;
2468     $levels =~ s/\s+$//;
2469     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2470
2471     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2472     if ( defined $env_debug ) {
2473         $levels{debug} = 1 if $env_debug; # Ugly!
2474         delete($levels{debug}) unless $env_debug;
2475     }
2476
2477     unless ( $class->log ) {
2478         $class->log( Catalyst::Log->new(keys %levels) );
2479     }
2480
2481     if ( $levels{debug} ) {
2482         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2483         $class->log->debug('Debug messages enabled');
2484     }
2485 }
2486
2487 =head2 $c->setup_plugins
2488
2489 Sets up plugins.
2490
2491 =cut
2492
2493 =head2 $c->setup_stats
2494
2495 Sets up timing statistics class.
2496
2497 =cut
2498
2499 sub setup_stats {
2500     my ( $class, $stats ) = @_;
2501
2502     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2503
2504     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2505     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2506         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2507         $class->log->debug('Statistics enabled');
2508     }
2509 }
2510
2511
2512 =head2 $c->registered_plugins
2513
2514 Returns a sorted list of the plugins which have either been stated in the
2515 import list or which have been added via C<< MyApp->plugin(@args); >>.
2516
2517 If passed a given plugin name, it will report a boolean value indicating
2518 whether or not that plugin is loaded.  A fully qualified name is required if
2519 the plugin name does not begin with C<Catalyst::Plugin::>.
2520
2521  if ($c->registered_plugins('Some::Plugin')) {
2522      ...
2523  }
2524
2525 =cut
2526
2527 {
2528
2529     sub registered_plugins {
2530         my $proto = shift;
2531         return sort keys %{ $proto->_plugins } unless @_;
2532         my $plugin = shift;
2533         return 1 if exists $proto->_plugins->{$plugin};
2534         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2535     }
2536
2537     sub _register_plugin {
2538         my ( $proto, $plugin, $instant ) = @_;
2539         my $class = ref $proto || $proto;
2540
2541         Class::MOP::load_class( $plugin );
2542
2543         $proto->_plugins->{$plugin} = 1;
2544         unless ($instant) {
2545             no strict 'refs';
2546             if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2547               my @superclasses = ($plugin, $meta->superclasses );
2548               $meta->superclasses(@superclasses);
2549             } else {
2550               unshift @{"$class\::ISA"}, $plugin;
2551             }
2552         }
2553         return $class;
2554     }
2555
2556     sub setup_plugins {
2557         my ( $class, $plugins ) = @_;
2558
2559         $class->_plugins( {} ) unless $class->_plugins;
2560         $plugins ||= [];
2561
2562         my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins);
2563
2564         for my $plugin ( reverse @plugins ) {
2565             Class::MOP::load_class($plugin);
2566             my $meta = find_meta($plugin);
2567             next if $meta && $meta->isa('Moose::Meta::Role');
2568
2569             $class->_register_plugin($plugin);
2570         }
2571
2572         my @roles =
2573             map { $_->name }
2574             grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
2575             map { find_meta($_) }
2576             @plugins;
2577
2578         Moose::Util::apply_all_roles(
2579             $class => @roles
2580         ) if @roles;
2581     }
2582 }
2583
2584 =head2 $c->stack
2585
2586 Returns an arrayref of the internal execution stack (actions that are
2587 currently executing).
2588
2589 =head2 $c->stats_class
2590
2591 Returns or sets the stats (timing statistics) class.
2592
2593 =head2 $c->use_stats
2594
2595 Returns 1 when stats collection is enabled.  Stats collection is enabled
2596 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2597 environment variable is set.
2598
2599 Note that this is a static method, not an accessor and should be overridden
2600 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2601
2602 =cut
2603
2604 sub use_stats { 0 }
2605
2606
2607 =head2 $c->write( $data )
2608
2609 Writes $data to the output stream. When using this method directly, you
2610 will need to manually set the C<Content-Length> header to the length of
2611 your output data, if known.
2612
2613 =cut
2614
2615 sub write {
2616     my $c = shift;
2617
2618     # Finalize headers if someone manually writes output
2619     $c->finalize_headers;
2620
2621     return $c->engine->write( $c, @_ );
2622 }
2623
2624 =head2 version
2625
2626 Returns the Catalyst version number. Mostly useful for "powered by"
2627 messages in template systems.
2628
2629 =cut
2630
2631 sub version { return $Catalyst::VERSION }
2632
2633 =head1 INTERNAL ACTIONS
2634
2635 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2636 C<_ACTION>, and C<_END>. These are by default not shown in the private
2637 action table, but you can make them visible with a config parameter.
2638
2639     MyApp->config(show_internal_actions => 1);
2640
2641 =head1 CASE SENSITIVITY
2642
2643 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2644 mapped to C</foo/bar>. You can activate case sensitivity with a config
2645 parameter.
2646
2647     MyApp->config(case_sensitive => 1);
2648
2649 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2650
2651 =head1 ON-DEMAND PARSER
2652
2653 The request body is usually parsed at the beginning of a request,
2654 but if you want to handle input yourself, you can enable on-demand
2655 parsing with a config parameter.
2656
2657     MyApp->config(parse_on_demand => 1);
2658
2659 =head1 PROXY SUPPORT
2660
2661 Many production servers operate using the common double-server approach,
2662 with a lightweight frontend web server passing requests to a larger
2663 backend server. An application running on the backend server must deal
2664 with two problems: the remote user always appears to be C<127.0.0.1> and
2665 the server's hostname will appear to be C<localhost> regardless of the
2666 virtual host that the user connected through.
2667
2668 Catalyst will automatically detect this situation when you are running
2669 the frontend and backend servers on the same machine. The following
2670 changes are made to the request.
2671
2672     $c->req->address is set to the user's real IP address, as read from
2673     the HTTP X-Forwarded-For header.
2674
2675     The host value for $c->req->base and $c->req->uri is set to the real
2676     host, as read from the HTTP X-Forwarded-Host header.
2677
2678 Additionally, you may be running your backend application on an insecure
2679 connection (port 80) while your frontend proxy is running under SSL.  If there
2680 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
2681 tell Catalyst what port the frontend listens on.  This will allow all URIs to
2682 be created properly.
2683
2684 In the case of passing in:
2685
2686     X-Forwarded-Port: 443
2687
2688 All calls to C<uri_for> will result in an https link, as is expected.
2689
2690 Obviously, your web server must support these headers for this to work.
2691
2692 In a more complex server farm environment where you may have your
2693 frontend proxy server(s) on different machines, you will need to set a
2694 configuration option to tell Catalyst to read the proxied data from the
2695 headers.
2696
2697     MyApp->config(using_frontend_proxy => 1);
2698
2699 If you do not wish to use the proxy support at all, you may set:
2700
2701     MyApp->config(ignore_frontend_proxy => 1);
2702
2703 =head1 THREAD SAFETY
2704
2705 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2706 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2707 believe the Catalyst core to be thread-safe.
2708
2709 If you plan to operate in a threaded environment, remember that all other
2710 modules you are using must also be thread-safe. Some modules, most notably
2711 L<DBD::SQLite>, are not thread-safe.
2712
2713 =head1 SUPPORT
2714
2715 IRC:
2716
2717     Join #catalyst on irc.perl.org.
2718
2719 Mailing Lists:
2720
2721     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2722     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2723
2724 Web:
2725
2726     http://catalyst.perl.org
2727
2728 Wiki:
2729
2730     http://dev.catalyst.perl.org
2731
2732 =head1 SEE ALSO
2733
2734 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2735
2736 =head2 L<Catalyst::Manual> - The Catalyst Manual
2737
2738 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
2739
2740 =head2 L<Catalyst::Engine> - Core engine
2741
2742 =head2 L<Catalyst::Log> - Log class.
2743
2744 =head2 L<Catalyst::Request> - Request object
2745
2746 =head2 L<Catalyst::Response> - Response object
2747
2748 =head2 L<Catalyst::Test> - The test suite.
2749
2750 =head1 PROJECT FOUNDER
2751
2752 sri: Sebastian Riedel <sri@cpan.org>
2753
2754 =head1 CONTRIBUTORS
2755
2756 abw: Andy Wardley
2757
2758 acme: Leon Brocard <leon@astray.com>
2759
2760 Andrew Bramble
2761
2762 Andrew Ford
2763
2764 Andrew Ruthven
2765
2766 andyg: Andy Grundman <andy@hybridized.org>
2767
2768 audreyt: Audrey Tang
2769
2770 bricas: Brian Cassidy <bricas@cpan.org>
2771
2772 Caelum: Rafael Kitover <rkitover@io.com>
2773
2774 chansen: Christian Hansen
2775
2776 chicks: Christopher Hicks
2777
2778 David E. Wheeler
2779
2780 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2781
2782 Drew Taylor
2783
2784 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
2785
2786 esskar: Sascha Kiefer
2787
2788 fireartist: Carl Franks <cfranks@cpan.org>
2789
2790 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
2791
2792 gabb: Danijel Milicevic
2793
2794 Gary Ashton Jones
2795
2796 Geoff Richards
2797
2798 hobbs: Andrew Rodland <andrew@cleverdomain.org>
2799
2800 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2801
2802 jcamacho: Juan Camacho
2803
2804 jester: Jesse Sheidlower
2805
2806 jhannah: Jay Hannah <jay@jays.net>
2807
2808 Jody Belka
2809
2810 Johan Lindstrom
2811
2812 jon: Jon Schutz <jjschutz@cpan.org>
2813
2814 konobi: Scott McWhirter <konobi@cpan.org>
2815
2816 marcus: Marcus Ramberg <mramberg@cpan.org>
2817
2818 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2819
2820 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2821
2822 mugwump: Sam Vilain
2823
2824 naughton: David Naughton
2825
2826 ningu: David Kamholz <dkamholz@cpan.org>
2827
2828 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2829
2830 numa: Dan Sully <daniel@cpan.org>
2831
2832 obra: Jesse Vincent
2833
2834 omega: Andreas Marienborg
2835
2836 Oleg Kostyuk <cub.uanic@gmail.com>
2837
2838 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2839
2840 rafl: Florian Ragwitz <rafl@debian.org>
2841
2842 random: Roland Lammel <lammel@cpan.org>
2843
2844 sky: Arthur Bergman
2845
2846 t0m: Tomas Doran <bobtfish@bobtfish.net>
2847
2848 Ulf Edvinsson
2849
2850 willert: Sebastian Willert <willert@cpan.org>
2851
2852 =head1 LICENSE
2853
2854 This library is free software. You can redistribute it and/or modify it under
2855 the same terms as Perl itself.
2856
2857 =cut
2858
2859 no Moose;
2860
2861 __PACKAGE__->meta->make_immutable;
2862
2863 1;