lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 use Moose::Meta::Class ();
   5 extends 'Catalyst::Component';
   6 use Moose::Util qw/find_meta/;
   7 use B::Hooks::EndOfScope ();
   8 use Catalyst::Exception;
   9 use Catalyst::Log;
  10 use Catalyst::Utils;
  11 use Catalyst::Controller;
  12 use Catalyst::Context;
  13 use Catalyst::Exception::Detach;
  14 use Catalyst::Exception::Go;
  15 use Devel::InnerPackage ();
  16 use Module::Pluggable::Object ();
  17 use Text::SimpleTable ();
  18 use Path::Class::Dir ();
  19 use Path::Class::File ();
  20 use Tree::Simple::Visitor::FindByUID;
  21 use Class::C3::Adopt::NEXT;
  22 use attributes;
  23 use utf8;
  24 use Carp qw/croak carp shortmess/;
  25
  26 BEGIN { require 5.008004; }
  27
  28 sub comp { shift->component(@_) }
  29
  30 #I imagine that very few of these really need to be class variables. if any.
  31 #maybe we should just make them attributes with a default?
  32 __PACKAGE__->mk_classdata($_)
  33   for qw/components arguments dispatcher engine log dispatcher_class
  34   engine_class context_class request_class response_class stats_class
  35   setup_finished/;
  36
  37 __PACKAGE__->context_class('Catalyst::Context');
  38 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  39 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  40 __PACKAGE__->request_class('Catalyst::Request');
  41 __PACKAGE__->response_class('Catalyst::Response');
  42 __PACKAGE__->stats_class('Catalyst::Stats');
  43
  44 # Remember to update this in Catalyst::Runtime as well!
  45
  46 our $VERSION = '5.80013';
  47
  48 {
  49     my $dev_version = $VERSION =~ /_\d{2}$/;
  50     *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
  51 }
  52
  53 $VERSION = eval $VERSION;
  54
  55 our $COUNT     = 1;
  56 our $START     = time;
  57 our $DETACH    = Catalyst::Exception::Detach->new;
  58 our $GO        = Catalyst::Exception::Go->new;
  59
  60 sub import {
  61     my ( $class, @arguments ) = @_;
  62
  63     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  64     # callers @ISA.
  65     return unless $class eq 'Catalyst';
  66
  67     my $caller = caller();
  68     return if $caller eq 'main';
  69
  70     # Kill Adopt::NEXT warnings if we're a non-RC version
  71     unless (_IS_DEVELOPMENT_VERSION()) {
  72         Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
  73     }
  74
  75     my $meta = Moose::Meta::Class->initialize($caller);
  76     # Make the caller inherit from Catalyst
  77     unless ( $caller->isa('Catalyst') ) {
  78         $meta->superclasses($meta->superclasses, 'Catalyst');
  79     }
  80     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
  81     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
  82
  83     unless( $meta->has_method('meta') ){
  84         $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
  85     }
  86
  87     $caller->arguments( [@arguments] );
  88     $caller->setup_home;
  89 }
  90
  91 sub _application { $_[0] }
  92
  93 =head1 NAME
  94
  95 Catalyst - The Elegant MVC Web Application Framework
  96
  97 =head1 SYNOPSIS
  98
  99 See the L<Catalyst::Manual> distribution for comprehensive
 100 documentation and tutorials.
 101
 102     # Install Catalyst::Devel for helpers and other development tools
 103     # use the helper to create a new application
 104     catalyst.pl MyApp
 105
 106     # add models, views, controllers
 107     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 108     script/myapp_create.pl view MyTemplate TT
 109     script/myapp_create.pl controller Search
 110
 111     # built in testserver -- use -r to restart automatically on changes
 112     # --help to see all available options
 113     script/myapp_server.pl
 114
 115     # command line testing interface
 116     script/myapp_test.pl /yada
 117
 118     ### in lib/MyApp.pm
 119     use Catalyst qw/-Debug/; # include plugins here as well
 120
 121     ### In lib/MyApp/Controller/Root.pm (autocreated)
 122     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 123         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 124         $c->stash->{template} = 'foo.tt'; # set the template
 125         # lookup something from db -- stash vars are passed to TT
 126         $c->stash->{data} =
 127           $c->model('Database::Foo')->search( { country => $args[0] } );
 128         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 129             $c->forward( 'bar' ); # process another action
 130             # do something else after forward returns
 131         }
 132     }
 133
 134     # The foo.tt TT template can use the stash data from the database
 135     [% WHILE (item = data.next) %]
 136         [% item.foo %]
 137     [% END %]
 138
 139     # called for /bar/of/soap, /bar/of/soap/10, etc.
 140     sub bar : Path('/bar/of/soap') { ... }
 141
 142     # called for all actions, from the top-most controller downwards
 143     sub auto : Private {
 144         my ( $self, $c ) = @_;
 145         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 146             $c->res->redirect( '/login' ); # require login
 147             return 0; # abort request and go immediately to end()
 148         }
 149         return 1; # success; carry on to next action
 150     }
 151
 152     # called after all actions are finished
 153     sub end : Private {
 154         my ( $self, $c ) = @_;
 155         if ( scalar @{ $c->error } ) { ... } # handle errors
 156         return if $c->res->body; # already have a response
 157         $c->forward( 'MyApp::View::TT' ); # render template
 158     }
 159
 160     ### in MyApp/Controller/Foo.pm
 161     # called for /foo/bar
 162     sub bar : Local { ... }
 163
 164     # called for /blargle
 165     sub blargle : Global { ... }
 166
 167     # an index action matches /foo, but not /foo/1, etc.
 168     sub index : Private { ... }
 169
 170     ### in MyApp/Controller/Foo/Bar.pm
 171     # called for /foo/bar/baz
 172     sub baz : Local { ... }
 173
 174     # first Root auto is called, then Foo auto, then this
 175     sub auto : Private { ... }
 176
 177     # powerful regular expression paths are also possible
 178     sub details : Regex('^product/(\w+)/details$') {
 179         my ( $self, $c ) = @_;
 180         # extract the (\w+) from the URI
 181         my $product = $c->req->captures->[0];
 182     }
 183
 184 See L<Catalyst::Manual::Intro> for additional information.
 185
 186 =head1 DESCRIPTION
 187
 188 Catalyst is a modern framework for making web applications without the
 189 pain usually associated with this process. This document is a reference
 190 to the main Catalyst application. If you are a new user, we suggest you
 191 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 192
 193 See L<Catalyst::Manual> for more documentation.
 194
 195 Catalyst plugins can be loaded by naming them as arguments to the "use
 196 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 197 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 198 C<My::Module>.
 199
 200     use Catalyst qw/My::Module/;
 201
 202 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 203 fully qualify the name by using a unary plus:
 204
 205     use Catalyst qw/
 206         My::Module
 207         +Fully::Qualified::Plugin::Name
 208     /;
 209
 210 Special flags like C<-Debug> and C<-Engine> can also be specified as
 211 arguments when Catalyst is loaded:
 212
 213     use Catalyst qw/-Debug My::Module/;
 214
 215 The position of plugins and flags in the chain is important, because
 216 they are loaded in the order in which they appear.
 217
 218 The following flags are supported:
 219
 220 =head2 -Debug
 221
 222 Enables debug output. You can also force this setting from the system
 223 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 224 settings override the application, with <MYAPP>_DEBUG having the highest
 225 priority.
 226
 227 =head2 -Engine
 228
 229 Forces Catalyst to use a specific engine. Omit the
 230 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 231
 232     use Catalyst qw/-Engine=CGI/;
 233
 234 =head2 -Home
 235
 236 Forces Catalyst to use a specific home directory, e.g.:
 237
 238     use Catalyst qw[-Home=/usr/mst];
 239
 240 This can also be done in the shell environment by setting either the
 241 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 242 is replaced with the uppercased name of your application, any "::" in
 243 the name will be replaced with underscores, e.g. MyApp::Web should use
 244 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 245
 246 =head2 -Log
 247
 248     use Catalyst '-Log=warn,fatal,error';
 249
 250 Specifies a comma-delimited list of log levels.
 251
 252 =head2 -Stats
 253
 254 Enables statistics collection and reporting. You can also force this setting
 255 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
 256 environment settings override the application, with <MYAPP>_STATS having the
 257 highest priority.
 258
 259 e.g.
 260
 261    use Catalyst qw/-Stats=1/
 262
 263 =head1 METHODS
 264
 265 =cut
 266
 267 =head2 $c->controller($name)
 268
 269 Gets a L<Catalyst::Controller> instance by name.
 270
 271     $c->controller('Foo')->do_stuff;
 272
 273 If the name is omitted, will return the controller for the dispatched
 274 action.
 275
 276 If you want to search for controllers, pass in a regexp as the argument.
 277
 278     # find all controllers that start with Foo
 279     my @foo_controllers = $c->controller(qr{^Foo});
 280
 281
 282 =cut
 283
 284 sub controller {
 285     my ( $c, $name, @args ) = @_;
 286
 287     if( $name ) {
 288         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
 289         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 290         return $c->_filter_component( $result[ 0 ], @args );
 291     }
 292
 293     return $c->component( $c->action->class );
 294 }
 295
 296 =head2 $c->view($name)
 297
 298 Gets a L<Catalyst::View> instance by name.
 299
 300 =cut
 301
 302 sub view {
 303     my ( $c, $name, @args ) = @_;
 304
 305     if( $name ) {
 306         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
 307         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 308         return $c->_filter_component( $result[ 0 ], @args );
 309     }
 310
 311     return $c->view( $c->config->{default_view} )
 312       if $c->config->{default_view};
 313     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
 314
 315     if( $rest ) {
 316         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 317         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
 318         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 319         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 320         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 321     }
 322
 323     return $c->_filter_component( $comp );
 324 }
 325
 326 =head2 $c->model($name)
 327
 328 Gets a L<Catalyst::Model> instance by name.
 329
 330 =cut
 331
 332 sub model {
 333     my ( $c, $name, @args ) = @_;
 334     if( $name ) {
 335         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
 336         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 337         return $c->_filter_component( $result[ 0 ], @args );
 338     }
 339
 340     return $c->model( $c->config->{default_model} )
 341       if $c->config->{default_model};
 342
 343     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
 344
 345     if( $rest ) {
 346         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
 347         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
 348         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 349         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 350         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 351     }
 352
 353     return $c->_filter_component( $comp );
 354 }
 355
 356
 357 sub _comp_search_prefixes {
 358     my $c = shift;
 359     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
 360 }
 361
 362 # search components given a name and some prefixes
 363 sub _comp_names_search_prefixes {
 364     my ( $c, $name, @prefixes ) = @_;
 365     my $appclass = ref $c || $c;
 366     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 367     $filter = qr/$filter/; # Compile regex now rather than once per loop
 368
 369     # map the original component name to the sub part that we will search against
 370     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 371         grep { /$filter/ } keys %{ $c->components };
 372
 373     # undef for a name will return all
 374     return keys %eligible if !defined $name;
 375
 376     my $query  = ref $name ? $name : qr/^$name$/i;
 377     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 378
 379     return @result if @result;
 380
 381     # if we were given a regexp to search against, we're done.
 382     return if ref $name;
 383
 384     # skip regexp fallback if configured
 385     return
 386         if $appclass->config->{disable_component_resolution_regex_fallback};
 387
 388     # regexp fallback
 389     $query  = qr/$name/i;
 390     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 391
 392     # no results? try against full names
 393     if( !@result ) {
 394         @result = grep { m{$query} } keys %eligible;
 395     }
 396
 397     # don't warn if we didn't find any results, it just might not exist
 398     if( @result ) {
 399         # Disgusting hack to work out correct method name
 400         my $warn_for = lc $prefixes[0];
 401         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
 402            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
 403            "component resolution is unreliable and unsafe.";
 404         my $short = $result[0];
 405         # remove the component namespace prefix
 406         $short =~ s/.*?(Model|Controller|View):://;
 407         my $shortmess = Carp::shortmess('');
 408         if ($shortmess =~ m#Catalyst/Plugin#) {
 409            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 410               "plugin's config";
 411         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
 412            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 413               "component's config";
 414         } else {
 415            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
 416               "but if you really wanted to search, pass in a regexp as the argument " .
 417               "like so: \$c->${warn_for}(qr/${name}/)";
 418         }
 419         $c->log->warn( "${msg}$shortmess" );
 420     }
 421
 422     return @result;
 423 }
 424
 425 # Find possible names for a prefix
 426 sub _comp_names {
 427     my ( $c, @prefixes ) = @_;
 428     my $appclass = ref $c || $c;
 429
 430     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 431
 432     my @names = map { s{$filter}{}; $_; }
 433         $c->_comp_names_search_prefixes( undef, @prefixes );
 434
 435     return @names;
 436 }
 437
 438 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 439 sub _filter_component {
 440     my ( $c, $comp, @args ) = @_;
 441
 442     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 443         return $comp->ACCEPT_CONTEXT( $c, @args );
 444     }
 445
 446     return $comp;
 447 }
 448
 449 =head2 COMPONENT ACCESSORS
 450
 451 =head2 $c->controllers
 452
 453 Returns the available names which can be passed to $c->controller
 454
 455 =cut
 456
 457 sub controllers {
 458     my ( $c ) = @_;
 459     return $c->_comp_names(qw/Controller C/);
 460 }
 461
 462 =head2 $c->models
 463
 464 Returns the available names which can be passed to $c->model
 465
 466 =cut
 467
 468 sub models {
 469     my ( $c ) = @_;
 470     return $c->_comp_names(qw/Model M/);
 471 }
 472
 473
 474 =head2 $c->views
 475
 476 Returns the available names which can be passed to $c->view
 477
 478 =cut
 479
 480 sub views {
 481     my ( $c ) = @_;
 482     return $c->_comp_names(qw/View V/);
 483 }
 484
 485 =head2 $c->comp($name)
 486
 487 =head2 $c->component($name)
 488
 489 Gets a component object by name. This method is not recommended,
 490 unless you want to get a specific component by full
 491 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 492 should be used instead.
 493
 494 If C<$name> is a regexp, a list of components matched against the full
 495 component name will be returned.
 496
 497 If Catalyst can't find a component by name, it will fallback to regex
 498 matching by default. To disable this behaviour set
 499 disable_component_resolution_regex_fallback to a true value.
 500
 501     __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
 502
 503 =cut
 504
 505 sub component {
 506     my ( $c, $name, @args ) = @_;
 507
 508     if( $name ) {
 509         my $comps = $c->components;
 510
 511         if( !ref $name ) {
 512             # is it the exact name?
 513             return $c->_filter_component( $comps->{ $name }, @args )
 514                        if exists $comps->{ $name };
 515
 516             # perhaps we just omitted "MyApp"?
 517             my $composed = ( ref $c || $c ) . "::${name}";
 518             return $c->_filter_component( $comps->{ $composed }, @args )
 519                        if exists $comps->{ $composed };
 520
 521             # search all of the models, views and controllers
 522             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
 523             return $c->_filter_component( $comp, @args ) if $comp;
 524         }
 525
 526         # This is here so $c->comp( '::M::' ) works
 527         my $query = ref $name ? $name : qr{$name}i;
 528
 529         my @result = grep { m{$query} } keys %{ $c->components };
 530         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 531
 532         if( $result[ 0 ] ) {
 533             $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 534             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 535             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 536             return $c->_filter_component( $result[ 0 ], @args );
 537         }
 538
 539         # I would expect to return an empty list here, but that breaks back-compat
 540     }
 541
 542     # fallback
 543     return sort keys %{ $c->components };
 544 }
 545
 546 =head2 CLASS DATA AND HELPER CLASSES
 547
 548 =head2 $c->config
 549
 550 Returns or takes a hashref containing the application's configuration.
 551
 552     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 553
 554 You can also use a C<YAML>, C<XML> or L<Config::General> config file
 555 like C<myapp.conf> in your applications home directory. See
 556 L<Catalyst::Plugin::ConfigLoader>.
 557
 558 =head3 Cascading configuration
 559
 560 The config method is present on all Catalyst components, and configuration
 561 will be merged when an application is started. Configuration loaded with
 562 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
 563 followed by configuration in your top level C<MyApp> class. These two
 564 configurations are merged, and then configuration data whose hash key matches a
 565 component name is merged with configuration for that component.
 566
 567 The configuration for a component is then passed to the C<new> method when a
 568 component is constructed.
 569
 570 For example:
 571
 572     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
 573     MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
 574
 575 will mean that C<MyApp::Model::Foo> receives the following data when
 576 constructed:
 577
 578     MyApp::Model::Foo->new({
 579         bar => 'baz',
 580         quux => 'frob',
 581         overrides => 'me',
 582     });
 583
 584 =cut
 585
 586 around config => sub {
 587     my $orig = shift;
 588     my $c = shift;
 589
 590     croak('Setting config after setup has been run is not allowed.')
 591         if ( @_ and $c->setup_finished );
 592
 593     $c->$orig(@_);
 594 };
 595
 596 =head2 $c->log
 597
 598 Returns the logging object instance. Unless it is already set, Catalyst
 599 sets this up with a L<Catalyst::Log> object. To use your own log class,
 600 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 601 C<< __PACKAGE__->setup >>.
 602
 603  __PACKAGE__->log( MyLogger->new );
 604  __PACKAGE__->setup;
 605
 606 And later:
 607
 608     $c->log->info( 'Now logging with my own logger!' );
 609
 610 Your log class should implement the methods described in
 611 L<Catalyst::Log>.
 612
 613
 614 =head2 $c->debug
 615
 616 Returns 1 if debug mode is enabled, 0 otherwise.
 617
 618 You can enable debug mode in several ways:
 619
 620 =over
 621
 622 =item By calling myapp_server.pl with the -d flag
 623
 624 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
 625
 626 =item The -Debug option in your MyApp.pm
 627
 628 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
 629
 630 =back
 631
 632 Calling C<< $c->debug(1) >> has no effect.
 633
 634 =cut
 635
 636 sub debug { 0 }
 637
 638 =head2 $c->dispatcher
 639
 640 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
 641
 642 =head2 $c->engine
 643
 644 Returns the engine instance. See L<Catalyst::Engine>.
 645
 646
 647 =head2 UTILITY METHODS
 648
 649 =head2 $c->path_to(@path)
 650
 651 Merges C<@path> with C<< $c->config->{home} >> and returns a
 652 L<Path::Class::Dir> object. Note you can usually use this object as
 653 a filename, but sometimes you will have to explicitly stringify it
 654 yourself by calling the C<< ->stringify >> method.
 655
 656 For example:
 657
 658     $c->path_to( 'db', 'sqlite.db' );
 659
 660 =cut
 661
 662 sub path_to {
 663     my ( $c, @path ) = @_;
 664     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 665     if ( -d $path ) { return $path }
 666     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 667 }
 668
 669 =head2 $c->plugin( $name, $class, @args )
 670
 671 Helper method for plugins. It creates a class data accessor/mutator and
 672 loads and instantiates the given class.
 673
 674     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 675
 676     $c->prototype->define_javascript_functions;
 677
 678 B<Note:> This method of adding plugins is deprecated. The ability
 679 to add plugins like this B<will be removed> in a Catalyst 5.81.
 680 Please do not use this functionality in new code.
 681
 682 =cut
 683
 684 sub plugin {
 685     my ( $class, $name, $plugin, @args ) = @_;
 686
 687     # See block comment in t/unit_core_plugin.t
 688     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
 689
 690     $class->_register_plugin( $plugin, 1 );
 691
 692     eval { $plugin->import };
 693     $class->mk_classdata($name);
 694     my $obj;
 695     eval { $obj = $plugin->new(@args) };
 696
 697     if ($@) {
 698         Catalyst::Exception->throw( message =>
 699               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 700     }
 701
 702     $class->$name($obj);
 703     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 704       if $class->debug;
 705 }
 706
 707 =head2 MyApp->setup
 708
 709 Initializes the dispatcher and engine, loads any plugins, and loads the
 710 model, view, and controller components. You may also specify an array
 711 of plugins to load here, if you choose to not load them in the C<use
 712 Catalyst> line.
 713
 714     MyApp->setup;
 715     MyApp->setup( qw/-Debug/ );
 716
 717 =cut
 718
 719 sub setup {
 720     my ( $class, @arguments ) = @_;
 721     croak('Running setup more than once')
 722         if ( $class->setup_finished );
 723
 724     unless ( $class->isa('Catalyst') ) {
 725
 726         Catalyst::Exception->throw(
 727             message => qq/'$class' does not inherit from Catalyst/ );
 728     }
 729
 730     if ( $class->arguments ) {
 731         @arguments = ( @arguments, @{ $class->arguments } );
 732     }
 733
 734     # Process options
 735     my $flags = {};
 736
 737     foreach (@arguments) {
 738
 739         if (/^-Debug$/) {
 740             $flags->{log} =
 741               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 742         }
 743         elsif (/^-(\w+)=?(.*)$/) {
 744             $flags->{ lc $1 } = $2;
 745         }
 746         else {
 747             push @{ $flags->{plugins} }, $_;
 748         }
 749     }
 750
 751     $class->setup_home( delete $flags->{home} );
 752
 753     $class->setup_log( delete $flags->{log} );
 754     $class->setup_plugins( delete $flags->{plugins} );
 755     $class->setup_dispatcher( delete $flags->{dispatcher} );
 756     $class->setup_engine( delete $flags->{engine} );
 757     $class->setup_stats( delete $flags->{stats} );
 758
 759     for my $flag ( sort keys %{$flags} ) {
 760
 761         if ( my $code = $class->can( 'setup_' . $flag ) ) {
 762             &$code( $class, delete $flags->{$flag} );
 763         }
 764         else {
 765             $class->log->warn(qq/Unknown flag "$flag"/);
 766         }
 767     }
 768
 769     eval { require Catalyst::Devel; };
 770     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
 771         $class->log->warn(<<"EOF");
 772 You are running an old script!
 773
 774   Please update by running (this will overwrite existing files):
 775     catalyst.pl -force -scripts $class
 776
 777   or (this will not overwrite existing files):
 778     catalyst.pl -scripts $class
 779
 780 EOF
 781     }
 782
 783     if ( $class->debug ) {
 784         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 785
 786         if (@plugins) {
 787             my $column_width = Catalyst::Utils::term_width() - 6;
 788             my $t = Text::SimpleTable->new($column_width);
 789             $t->row($_) for @plugins;
 790             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
 791         }
 792
 793         my $dispatcher = $class->dispatcher;
 794         my $engine     = $class->engine;
 795         my $home       = $class->config->{home};
 796
 797         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
 798         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
 799
 800         $home
 801           ? ( -d $home )
 802           ? $class->log->debug(qq/Found home "$home"/)
 803           : $class->log->debug(qq/Home "$home" doesn't exist/)
 804           : $class->log->debug(q/Couldn't find home/);
 805     }
 806
 807     # Call plugins setup, this is stupid and evil.
 808     # Also screws C3 badly on 5.10, hack to avoid.
 809     {
 810         no warnings qw/redefine/;
 811         local *setup = sub { };
 812         $class->setup unless $Catalyst::__AM_RESTARTING;
 813     }
 814
 815     # Initialize our data structure
 816     $class->components( {} );
 817
 818     $class->setup_components;
 819
 820     if ( $class->debug ) {
 821         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
 822         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
 823         for my $comp ( sort keys %{ $class->components } ) {
 824             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
 825             $t->row( $comp, $type );
 826         }
 827         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
 828           if ( keys %{ $class->components } );
 829     }
 830
 831     $class->setup_actions;
 832
 833     if ( $class->debug ) {
 834         my $name = $class->config->{name} || 'Application';
 835         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 836     }
 837
 838     # Make sure that the application class becomes immutable at this point,
 839     B::Hooks::EndOfScope::on_scope_end {
 840         return if $@;
 841         my $meta = Class::MOP::get_metaclass_by_name($class);
 842         if (
 843             $meta->is_immutable
 844             && ! { $meta->immutable_options }->{replace_constructor}
 845             && (
 846                    $class->isa('Class::Accessor::Fast')
 847                 || $class->isa('Class::Accessor')
 848             )
 849         ) {
 850             warn "You made your application class ($class) immutable, "
 851                 . "but did not inline the\nconstructor. "
 852                 . "This will break catalyst, as your app \@ISA "
 853                 . "Class::Accessor(::Fast)?\nPlease pass "
 854                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
 855         }
 856         $meta->make_immutable(
 857             replace_constructor => 1,
 858         ) unless $meta->is_immutable;
 859     };
 860
 861     $class->setup_finalize;
 862     # Should be the last thing we do so that user things hooking
 863     # setup_finalize can log..
 864     $class->log->_flush() if $class->log->can('_flush');
 865     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
 866 }
 867
 868
 869 =head2 $app->setup_finalize
 870
 871 A hook to attach modifiers to.
 872 Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
 873 Also better than C< setup_finished(); >, as that is a getter method.
 874
 875     sub setup_finalize {
 876
 877         my $app = shift;
 878
 879         ## do stuff, i.e., determine a primary key column for sessions stored in a DB
 880
 881         $app->next::method(@_);
 882
 883
 884     }
 885
 886 =cut
 887
 888 sub setup_finalize {
 889     my ($class) = @_;
 890     $class->setup_finished(1);
 891 }
 892
 893 =head2 $c->welcome_message
 894
 895 Returns the Catalyst welcome HTML page.
 896
 897 =cut
 898
 899 sub welcome_message {
 900     my $c      = shift;
 901     my $name   = $c->config->{name};
 902     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
 903     my $prefix = Catalyst::Utils::appprefix( ref $c );
 904     $c->response->content_type('text/html; charset=utf-8');
 905     return <<"EOF";
 906 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 907     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 908 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 909     <head>
 910     <meta http-equiv="Content-Language" content="en" />
 911     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 912         <title>$name on Catalyst $VERSION</title>
 913         <style type="text/css">
 914             body {
 915                 color: #000;
 916                 background-color: #eee;
 917             }
 918             div#content {
 919                 width: 640px;
 920                 margin-left: auto;
 921                 margin-right: auto;
 922                 margin-top: 10px;
 923                 margin-bottom: 10px;
 924                 text-align: left;
 925                 background-color: #ccc;
 926                 border: 1px solid #aaa;
 927             }
 928             p, h1, h2 {
 929                 margin-left: 20px;
 930                 margin-right: 20px;
 931                 font-family: verdana, tahoma, sans-serif;
 932             }
 933             a {
 934                 font-family: verdana, tahoma, sans-serif;
 935             }
 936             :link, :visited {
 937                     text-decoration: none;
 938                     color: #b00;
 939                     border-bottom: 1px dotted #bbb;
 940             }
 941             :link:hover, :visited:hover {
 942                     color: #555;
 943             }
 944             div#topbar {
 945                 margin: 0px;
 946             }
 947             pre {
 948                 margin: 10px;
 949                 padding: 8px;
 950             }
 951             div#answers {
 952                 padding: 8px;
 953                 margin: 10px;
 954                 background-color: #fff;
 955                 border: 1px solid #aaa;
 956             }
 957             h1 {
 958                 font-size: 0.9em;
 959                 font-weight: normal;
 960                 text-align: center;
 961             }
 962             h2 {
 963                 font-size: 1.0em;
 964             }
 965             p {
 966                 font-size: 0.9em;
 967             }
 968             p img {
 969                 float: right;
 970                 margin-left: 10px;
 971             }
 972             span#appname {
 973                 font-weight: bold;
 974                 font-size: 1.6em;
 975             }
 976         </style>
 977     </head>
 978     <body>
 979         <div id="content">
 980             <div id="topbar">
 981                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
 982                     $VERSION</h1>
 983              </div>
 984              <div id="answers">
 985                  <p>
 986                  <img src="$logo" alt="Catalyst Logo" />
 987                  </p>
 988                  <p>Welcome to the  world of Catalyst.
 989                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
 990                     framework will make web development something you had
 991                     never expected it to be: Fun, rewarding, and quick.</p>
 992                  <h2>What to do now?</h2>
 993                  <p>That really depends  on what <b>you</b> want to do.
 994                     We do, however, provide you with a few starting points.</p>
 995                  <p>If you want to jump right into web development with Catalyst
 996                     you might want to start with a tutorial.</p>
 997 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
 998 </pre>
 999 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1000 <pre>
1001 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1002 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1003 </code></pre>
1004                  <h2>What to do next?</h2>
1005                  <p>Next it's time to write an actual application. Use the
1006                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1007                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1008                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1009                     they can save you a lot of work.</p>
1010                     <pre><code>script/${prefix}_create.pl -help</code></pre>
1011                     <p>Also, be sure to check out the vast and growing
1012                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1013                     you are likely to find what you need there.
1014                     </p>
1015
1016                  <h2>Need help?</h2>
1017                  <p>Catalyst has a very active community. Here are the main places to
1018                     get in touch with us.</p>
1019                  <ul>
1020                      <li>
1021                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1022                      </li>
1023                      <li>
1024                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1025                      </li>
1026                      <li>
1027                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1028                      </li>
1029                  </ul>
1030                  <h2>In conclusion</h2>
1031                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1032                     as we enjoyed making it. Please contact us if you have ideas
1033                     for improvement or other feedback.</p>
1034              </div>
1035          </div>
1036     </body>
1037 </html>
1038 EOF
1039 }
1040
1041 =head1 INTERNAL METHODS
1042
1043 These methods are not meant to be used by end users.
1044
1045 =head2 $c->components
1046
1047 Returns a hash of components.
1048
1049 =head2 $c->context_class
1050
1051 Returns or sets the context class.
1052
1053 =head2 $c->dispatcher_class
1054
1055 Returns or sets the dispatcher class.
1056
1057 =head2 $c->engine_class
1058
1059 Returns or sets the engine class.
1060
1061 =head2 $c->handle_request( $class, @arguments )
1062
1063 Called to handle each HTTP request.
1064
1065 =cut
1066
1067 sub handle_request {
1068     my ( $class, @arguments ) = @_;
1069
1070     # Always expect worst case!
1071     my $status = -1;
1072     eval {
1073         if ($class->debug) {
1074             my $secs = time - $START || 1;
1075             my $av = sprintf '%.3f', $COUNT / $secs;
1076             my $time = localtime time;
1077             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1078         }
1079
1080         my $c = $class->prepare(@arguments);
1081         $c->dispatch;
1082         $status = $c->finalize;
1083     };
1084
1085     if ( my $error = $@ ) {
1086         chomp $error;
1087         $class->log->error(qq/Caught exception in engine "$error"/);
1088     }
1089
1090     $COUNT++;
1091
1092     if(my $coderef = $class->log->can('_flush')){
1093         $class->log->$coderef();
1094     }
1095     return $status;
1096 }
1097
1098 =head2 $c->prepare( @arguments )
1099
1100 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1101 etc.).
1102
1103 =cut
1104
1105 sub prepare {
1106     my ( $class, @arguments ) = @_;
1107
1108     # XXX
1109     # After the app/ctxt split, this should become an attribute based on something passed
1110     # into the application.
1111     $class->context_class( ref $class || $class ) unless $class->context_class;
1112
1113     my $app = $class->new({});
1114     my $c = $class->context_class->new( application => $app );
1115
1116     # For on-demand data
1117     $c->request->_context($c);
1118     $c->response->_context($c);
1119
1120     #surely this is not the most efficient way to do things...
1121     $c->stats($class->stats_class->new)->enable($c->use_stats);
1122     if ( $c->debug ) {
1123         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1124     }
1125
1126     #XXX reuse coderef from can
1127     # Allow engine to direct the prepare flow (for POE)
1128     if ( $c->engine->can('prepare') ) {
1129         $c->engine->prepare( $c, @arguments );
1130     }
1131     else {
1132         $c->prepare_request(@arguments);
1133         $c->prepare_connection;
1134         $c->prepare_query_parameters;
1135         $c->prepare_headers;
1136         $c->prepare_cookies;
1137         $c->prepare_path;
1138
1139         # Prepare the body for reading, either by prepare_body
1140         # or the user, if they are using $c->read
1141         $c->prepare_read;
1142
1143         # Parse the body unless the user wants it on-demand
1144         unless ( $app->config->{parse_on_demand} ) {
1145             $c->prepare_body;
1146         }
1147     }
1148
1149     my $method  = $c->req->method  || '';
1150     my $path    = $c->req->path;
1151     $path       = '/' unless length $path;
1152     my $address = $c->req->address || '';
1153
1154     $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1155       if $c->debug;
1156
1157     $c->prepare_action;
1158
1159     return $c;
1160 }
1161
1162 =head2 $c->request_class
1163
1164 Returns or sets the request class.
1165
1166 =head2 $c->response_class
1167
1168 Returns or sets the response class.
1169
1170 =head2 $c->run
1171
1172 Starts the engine.
1173
1174 =cut
1175
1176 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1177
1178 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1179
1180 Sets an action in a given namespace.
1181
1182 =cut
1183
1184 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1185
1186 =head2 $c->setup_actions($component)
1187
1188 Sets up actions for a component.
1189
1190 =cut
1191
1192 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1193
1194 =head2 $c->setup_components
1195
1196 This method is called internally to set up the application's components.
1197
1198 It finds modules by calling the L<locate_components> method, expands them to
1199 package names with the L<expand_component_module> method, and then installs
1200 each component into the application.
1201
1202 The C<setup_components> config option is passed to both of the above methods.
1203
1204 Installation of each component is performed by the L<setup_component> method,
1205 below.
1206
1207 =cut
1208
1209 sub setup_components {
1210     my $class = shift;
1211
1212     my $config  = $class->config->{ setup_components };
1213
1214     my @comps = sort { length $a <=> length $b }
1215                 $class->locate_components($config);
1216     my %comps = map { $_ => 1 } @comps;
1217
1218     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
1219     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
1220         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
1221     ) if $deprecatedcatalyst_component_names;
1222
1223     for my $component ( @comps ) {
1224
1225         # We pass ignore_loaded here so that overlay files for (e.g.)
1226         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
1227         # we know M::P::O found a file on disk so this is safe
1228
1229         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1230
1231         # Needs to be done as soon as the component is loaded, as loading a sub-component
1232         # (next time round the loop) can cause us to get the wrong metaclass..
1233         $class->_controller_init_base_classes($component);
1234     }
1235
1236     for my $component (@comps) {
1237         $class->components->{ $component } = $class->setup_component($component);
1238         for my $component ($class->expand_component_module( $component, $config )) {
1239             next if $comps{$component};
1240             $class->_controller_init_base_classes($component); # Also cover inner packages
1241             $class->components->{ $component } = $class->setup_component($component);
1242         }
1243     }
1244 }
1245
1246 =head2 $c->locate_components( $setup_component_config )
1247
1248 This method is meant to provide a list of component modules that should be
1249 setup for the application.  By default, it will use L<Module::Pluggable>.
1250
1251 Specify a C<setup_components> config option to pass additional options directly
1252 to L<Module::Pluggable>. To add additional search paths, specify a key named
1253 C<search_extra> as an array reference. Items in the array beginning with C<::>
1254 will have the application class name prepended to them.
1255
1256 =cut
1257
1258 sub locate_components {
1259     my $class  = shift;
1260     my $config = shift;
1261
1262     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
1263     my $extra   = delete $config->{ search_extra } || [];
1264
1265     push @paths, @$extra;
1266
1267     my $locator = Module::Pluggable::Object->new(
1268         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1269         %$config
1270     );
1271
1272     my @comps = $locator->plugins;
1273
1274     return @comps;
1275 }
1276
1277 =head2 $c->expand_component_module( $component, $setup_component_config )
1278
1279 Components found by C<locate_components> will be passed to this method, which
1280 is expected to return a list of component (package) names to be set up.
1281
1282 =cut
1283
1284 sub expand_component_module {
1285     my ($class, $module) = @_;
1286     return Devel::InnerPackage::list_packages( $module );
1287 }
1288
1289 =head2 $c->setup_component
1290
1291 =cut
1292
1293 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
1294 #         nearest to Catalyst::Controller first, no matter what order stuff happens
1295 #         to be loaded. There are TODO tests in Moose for this, see
1296 #         f2391d17574eff81d911b97be15ea51080500003
1297 sub _controller_init_base_classes {
1298     my ($app_class, $component) = @_;
1299     return unless $component->isa('Catalyst::Controller');
1300     foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
1301         Moose::Meta::Class->initialize( $class )
1302             unless find_meta($class);
1303     }
1304 }
1305
1306 sub setup_component {
1307     my( $class, $component ) = @_;
1308
1309     unless ( $component->can( 'COMPONENT' ) ) {
1310         return $component;
1311     }
1312
1313     my $suffix = Catalyst::Utils::class2classsuffix( $component );
1314     my $config = $class->config->{ $suffix } || {};
1315     # Stash catalyst_component_name in the config here, so that custom COMPONENT
1316     # methods also pass it. local to avoid pointlessly shitting in config
1317     # for the debug screen, as $component is already the key name.
1318     local $config->{catalyst_component_name} = $component;
1319
1320     my $instance = eval { $component->COMPONENT( $class, $config ); };
1321
1322     if ( my $error = $@ ) {
1323         chomp $error;
1324         Catalyst::Exception->throw(
1325             message => qq/Couldn't instantiate component "$component", "$error"/
1326         );
1327     }
1328
1329     unless (blessed $instance) {
1330         my $metaclass = Moose::Util::find_meta($component);
1331         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
1332         my $component_method_from = $method_meta->associated_metaclass->name;
1333         my $value = defined($instance) ? $instance : 'undef';
1334         Catalyst::Exception->throw(
1335             message =>
1336             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
1337         );
1338     }
1339     return $instance;
1340 }
1341
1342 =head2 $c->setup_dispatcher
1343
1344 Sets up dispatcher.
1345
1346 =cut
1347
1348 sub setup_dispatcher {
1349     my ( $class, $dispatcher ) = @_;
1350
1351     if ($dispatcher) {
1352         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1353     }
1354
1355     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
1356         $dispatcher = 'Catalyst::Dispatcher::' . $env;
1357     }
1358
1359     unless ($dispatcher) {
1360         $dispatcher = $class->dispatcher_class;
1361     }
1362
1363     Class::MOP::load_class($dispatcher);
1364
1365     # dispatcher instance
1366     $class->dispatcher( $dispatcher->new );
1367 }
1368
1369 =head2 $c->setup_engine
1370
1371 Sets up engine.
1372
1373 =cut
1374
1375 sub setup_engine {
1376     my ( $class, $engine ) = @_;
1377
1378     if ($engine) {
1379         $engine = 'Catalyst::Engine::' . $engine;
1380     }
1381
1382     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
1383         $engine = 'Catalyst::Engine::' . $env;
1384     }
1385
1386     if ( $ENV{MOD_PERL} ) {
1387         my $meta = Class::MOP::get_metaclass_by_name($class);
1388
1389         # create the apache method
1390         $meta->add_method('apache' => sub { shift->engine->apache });
1391
1392         my ( $software, $version ) =
1393           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1394
1395         $version =~ s/_//g;
1396         $version =~ s/(\.[^.]+)\./$1/g;
1397
1398         if ( $software eq 'mod_perl' ) {
1399
1400             if ( !$engine ) {
1401
1402                 if ( $version >= 1.99922 ) {
1403                     $engine = 'Catalyst::Engine::Apache2::MP20';
1404                 }
1405
1406                 elsif ( $version >= 1.9901 ) {
1407                     $engine = 'Catalyst::Engine::Apache2::MP19';
1408                 }
1409
1410                 elsif ( $version >= 1.24 ) {
1411                     $engine = 'Catalyst::Engine::Apache::MP13';
1412                 }
1413
1414                 else {
1415                     Catalyst::Exception->throw( message =>
1416                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1417                 }
1418
1419             }
1420
1421             # install the correct mod_perl handler
1422             if ( $version >= 1.9901 ) {
1423                 *handler = sub  : method {
1424                     shift->handle_request(@_);
1425                 };
1426             }
1427             else {
1428                 *handler = sub ($$) { shift->handle_request(@_) };
1429             }
1430
1431         }
1432
1433         elsif ( $software eq 'Zeus-Perl' ) {
1434             $engine = 'Catalyst::Engine::Zeus';
1435         }
1436
1437         else {
1438             Catalyst::Exception->throw(
1439                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1440         }
1441     }
1442
1443     unless ($engine) {
1444         $engine = $class->engine_class;
1445     }
1446
1447     Class::MOP::load_class($engine);
1448
1449     # check for old engines that are no longer compatible
1450     my $old_engine;
1451     if ( $engine->isa('Catalyst::Engine::Apache')
1452         && !Catalyst::Engine::Apache->VERSION )
1453     {
1454         $old_engine = 1;
1455     }
1456
1457     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1458         && Catalyst::Engine::Server->VERSION le '0.02' )
1459     {
1460         $old_engine = 1;
1461     }
1462
1463     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1464         && $engine->VERSION eq '0.01' )
1465     {
1466         $old_engine = 1;
1467     }
1468
1469     elsif ($engine->isa('Catalyst::Engine::Zeus')
1470         && $engine->VERSION eq '0.01' )
1471     {
1472         $old_engine = 1;
1473     }
1474
1475     if ($old_engine) {
1476         Catalyst::Exception->throw( message =>
1477               qq/Engine "$engine" is not supported by this version of Catalyst/
1478         );
1479     }
1480
1481     # engine instance
1482     $class->engine( $engine->new );
1483 }
1484
1485 =head2 $c->setup_home
1486
1487 Sets up the home directory.
1488
1489 =cut
1490
1491 sub setup_home {
1492     my ( $class, $home ) = @_;
1493
1494     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
1495         $home = $env;
1496     }
1497
1498     $home ||= Catalyst::Utils::home($class);
1499
1500     if ($home) {
1501         #I remember recently being scolded for assigning config values like this
1502         $class->config->{home} ||= $home;
1503         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
1504     }
1505 }
1506
1507 =head2 $c->setup_log
1508
1509 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
1510 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
1511 log to.
1512
1513 This method also installs a C<debug> method that returns a true value into the
1514 catalyst subclass if the "debug" level is passed in the comma-delimited list,
1515 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
1516
1517 Note that if the log has already been setup, by either a previous call to
1518 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
1519 that this method won't actually set up the log object.
1520
1521 =cut
1522
1523 sub setup_log {
1524     my ( $class, $levels ) = @_;
1525
1526     $levels ||= '';
1527     $levels =~ s/^\s+//;
1528     $levels =~ s/\s+$//;
1529     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
1530
1531     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
1532     if ( defined $env_debug ) {
1533         $levels{debug} = 1 if $env_debug; # Ugly!
1534         delete($levels{debug}) unless $env_debug;
1535     }
1536
1537     unless ( $class->log ) {
1538         $class->log( Catalyst::Log->new(keys %levels) );
1539     }
1540
1541     if ( $levels{debug} ) {
1542         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
1543         $class->log->debug('Debug messages enabled');
1544     }
1545 }
1546
1547 =head2 $c->setup_plugins
1548
1549 Sets up plugins.
1550
1551 =cut
1552
1553 =head2 $c->setup_stats
1554
1555 Sets up timing statistics class.
1556
1557 =cut
1558
1559 sub setup_stats {
1560     my ( $class, $stats ) = @_;
1561
1562     Catalyst::Utils::ensure_class_loaded($class->stats_class);
1563
1564     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
1565     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
1566         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
1567         $class->log->debug('Statistics enabled');
1568     }
1569 }
1570
1571
1572 =head2 $c->registered_plugins
1573
1574 Returns a sorted list of the plugins which have either been stated in the
1575 import list or which have been added via C<< MyApp->plugin(@args); >>.
1576
1577 If passed a given plugin name, it will report a boolean value indicating
1578 whether or not that plugin is loaded.  A fully qualified name is required if
1579 the plugin name does not begin with C<Catalyst::Plugin::>.
1580
1581  if ($c->registered_plugins('Some::Plugin')) {
1582      ...
1583  }
1584
1585 =cut
1586
1587 {
1588
1589     sub registered_plugins {
1590         my $proto = shift;
1591         return sort keys %{ $proto->_plugins } unless @_;
1592         my $plugin = shift;
1593         return 1 if exists $proto->_plugins->{$plugin};
1594         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
1595     }
1596
1597     sub _register_plugin {
1598         my ( $proto, $plugin, $instant ) = @_;
1599         my $class = ref $proto || $proto;
1600
1601         Class::MOP::load_class( $plugin );
1602
1603         $proto->_plugins->{$plugin} = 1;
1604         unless ($instant) {
1605             no strict 'refs';
1606             if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
1607               my @superclasses = ($plugin, $meta->superclasses );
1608               $meta->superclasses(@superclasses);
1609             } else {
1610               unshift @{"$class\::ISA"}, $plugin;
1611             }
1612         }
1613         return $class;
1614     }
1615
1616     sub setup_plugins {
1617         my ( $class, $plugins ) = @_;
1618
1619         $class->_plugins( {} ) unless $class->_plugins;
1620         $plugins ||= [];
1621
1622         my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins);
1623
1624         for my $plugin ( reverse @plugins ) {
1625             Class::MOP::load_class($plugin);
1626             my $meta = find_meta($plugin);
1627             next if $meta && $meta->isa('Moose::Meta::Role');
1628
1629             $class->_register_plugin($plugin);
1630         }
1631
1632         my @roles =
1633             map { $_->name }
1634             grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
1635             map { find_meta($_) }
1636             @plugins;
1637
1638         Moose::Util::apply_all_roles(
1639             $class => @roles
1640         ) if @roles;
1641     }
1642 }
1643
1644 =head2 $c->stats_class
1645
1646 Returns or sets the stats (timing statistics) class.
1647
1648 =head2 $c->use_stats
1649
1650 Returns 1 when stats collection is enabled.  Stats collection is enabled
1651 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
1652 environment variable is set.
1653
1654 Note that this is a static method, not an accessor and should be overridden
1655 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
1656
1657 =cut
1658
1659 sub use_stats { 0 }
1660
1661 =head2 version
1662
1663 Returns the Catalyst version number. Mostly useful for "powered by"
1664 messages in template systems.
1665
1666 =cut
1667
1668 sub version { return $Catalyst::VERSION }
1669
1670 =head1 CONFIGURATION
1671
1672 There are a number of 'base' config variables which can be set:
1673
1674 =over
1675
1676 =item *
1677
1678 C<default_model> - The default model picked if you say C<< $c->model >>. See L</$c->model($name)>.
1679
1680 =item *
1681
1682 C<default_view> - The default view to be rendered or returned when C<< $c->view >>. See L</$c->view($name)>.
1683 is called.
1684
1685 =item *
1686
1687 C<disable_component_resolution_regex_fallback> - Turns
1688 off the deprecated component resolution functionality so
1689 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
1690 are called then regex search will not be attempted on string values and
1691 instead C<undef> will be returned.
1692
1693 =item *
1694
1695 C<home> - The application home directory. In an uninstalled application,
1696 this is the top level application directory. In an installed application,
1697 this will be the directory containing C<< MyApp.pm >>.
1698
1699 =item *
1700
1701 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
1702
1703 =item *
1704
1705 C<name> - The name of the application in debug messages and the debug and
1706 welcome screens
1707
1708 =item *
1709
1710 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
1711 until it is accessed. This allows you to (for example) check authentication (and reject
1712 the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
1713
1714 =item *
1715
1716 C<root> - The root directory for templates. Usually this is just a
1717 subdirectory of the home directory, but you can set it to change the
1718 templates to a different directory.
1719
1720 =item *
1721
1722 C<search_extra> - Array reference passed to Module::Pluggable to for additional
1723 namespaces from which components will be loaded (and constructed and stored in
1724 C<< $c->components >>).
1725
1726 =item *
1727
1728 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
1729 to be shown in hit debug tables in the test server.
1730
1731 =item *
1732
1733 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
1734
1735 =back
1736
1737 =head1 INTERNAL ACTIONS
1738
1739 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
1740 C<_ACTION>, and C<_END>. These are by default not shown in the private
1741 action table, but you can make them visible with a config parameter.
1742
1743     MyApp->config(show_internal_actions => 1);
1744
1745 =head1 ON-DEMAND PARSER
1746
1747 The request body is usually parsed at the beginning of a request,
1748 but if you want to handle input yourself, you can enable on-demand
1749 parsing with a config parameter.
1750
1751     MyApp->config(parse_on_demand => 1);
1752
1753 =head1 PROXY SUPPORT
1754
1755 Many production servers operate using the common double-server approach,
1756 with a lightweight frontend web server passing requests to a larger
1757 backend server. An application running on the backend server must deal
1758 with two problems: the remote user always appears to be C<127.0.0.1> and
1759 the server's hostname will appear to be C<localhost> regardless of the
1760 virtual host that the user connected through.
1761
1762 Catalyst will automatically detect this situation when you are running
1763 the frontend and backend servers on the same machine. The following
1764 changes are made to the request.
1765
1766     $c->req->address is set to the user's real IP address, as read from
1767     the HTTP X-Forwarded-For header.
1768
1769     The host value for $c->req->base and $c->req->uri is set to the real
1770     host, as read from the HTTP X-Forwarded-Host header.
1771
1772 Additionally, you may be running your backend application on an insecure
1773 connection (port 80) while your frontend proxy is running under SSL.  If there
1774 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
1775 tell Catalyst what port the frontend listens on.  This will allow all URIs to
1776 be created properly.
1777
1778 In the case of passing in:
1779
1780     X-Forwarded-Port: 443
1781
1782 All calls to C<uri_for> will result in an https link, as is expected.
1783
1784 Obviously, your web server must support these headers for this to work.
1785
1786 In a more complex server farm environment where you may have your
1787 frontend proxy server(s) on different machines, you will need to set a
1788 configuration option to tell Catalyst to read the proxied data from the
1789 headers.
1790
1791     MyApp->config(using_frontend_proxy => 1);
1792
1793 If you do not wish to use the proxy support at all, you may set:
1794
1795     MyApp->config(ignore_frontend_proxy => 1);
1796
1797 =head1 THREAD SAFETY
1798
1799 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
1800 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
1801 believe the Catalyst core to be thread-safe.
1802
1803 If you plan to operate in a threaded environment, remember that all other
1804 modules you are using must also be thread-safe. Some modules, most notably
1805 L<DBD::SQLite>, are not thread-safe.
1806
1807 =head1 SUPPORT
1808
1809 IRC:
1810
1811     Join #catalyst on irc.perl.org.
1812
1813 Mailing Lists:
1814
1815     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
1816     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
1817
1818 Web:
1819
1820     http://catalyst.perl.org
1821
1822 Wiki:
1823
1824     http://dev.catalyst.perl.org
1825
1826 =head1 SEE ALSO
1827
1828 =head2 L<Task::Catalyst> - All you need to start with Catalyst
1829
1830 =head2 L<Catalyst::Manual> - The Catalyst Manual
1831
1832 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
1833
1834 =head2 L<Catalyst::Engine> - Core engine
1835
1836 =head2 L<Catalyst::Log> - Log class.
1837
1838 =head2 L<Catalyst::Request> - Request object
1839
1840 =head2 L<Catalyst::Response> - Response object
1841
1842 =head2 L<Catalyst::Test> - The test suite.
1843
1844 =head1 PROJECT FOUNDER
1845
1846 sri: Sebastian Riedel <sri@cpan.org>
1847
1848 =head1 CONTRIBUTORS
1849
1850 abw: Andy Wardley
1851
1852 acme: Leon Brocard <leon@astray.com>
1853
1854 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
1855
1856 Andrew Bramble
1857
1858 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
1859
1860 Andrew Ruthven
1861
1862 andyg: Andy Grundman <andy@hybridized.org>
1863
1864 audreyt: Audrey Tang
1865
1866 bricas: Brian Cassidy <bricas@cpan.org>
1867
1868 Caelum: Rafael Kitover <rkitover@io.com>
1869
1870 chansen: Christian Hansen
1871
1872 chicks: Christopher Hicks
1873
1874 Chisel Wright C<pause@herlpacker.co.uk>
1875
1876 Danijel Milicevic C<me@danijel.de>
1877
1878 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
1879
1880 David Naughton, C<naughton@umn.edu>
1881
1882 David E. Wheeler
1883
1884 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
1885
1886 Drew Taylor
1887
1888 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
1889
1890 esskar: Sascha Kiefer
1891
1892 fireartist: Carl Franks <cfranks@cpan.org>
1893
1894 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
1895
1896 gabb: Danijel Milicevic
1897
1898 Gary Ashton Jones
1899
1900 Gavin Henry C<ghenry@perl.me.uk>
1901
1902 Geoff Richards
1903
1904 groditi: Guillermo Roditi <groditi@gmail.com>
1905
1906 hobbs: Andrew Rodland <andrew@cleverdomain.org>
1907
1908 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
1909
1910 jcamacho: Juan Camacho
1911
1912 jester: Jesse Sheidlower C<jester@panix.com>
1913
1914 jhannah: Jay Hannah <jay@jays.net>
1915
1916 Jody Belka
1917
1918 Johan Lindstrom
1919
1920 jon: Jon Schutz <jjschutz@cpan.org>
1921
1922 Jonathan Rockway C<< <jrockway@cpan.org> >>
1923
1924 Kieren Diment C<kd@totaldatasolution.com>
1925
1926 konobi: Scott McWhirter <konobi@cpan.org>
1927
1928 marcus: Marcus Ramberg <mramberg@cpan.org>
1929
1930 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
1931
1932 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
1933
1934 mugwump: Sam Vilain
1935
1936 naughton: David Naughton
1937
1938 ningu: David Kamholz <dkamholz@cpan.org>
1939
1940 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
1941
1942 numa: Dan Sully <daniel@cpan.org>
1943
1944 obra: Jesse Vincent
1945
1946 omega: Andreas Marienborg
1947
1948 Oleg Kostyuk <cub.uanic@gmail.com>
1949
1950 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
1951
1952 rafl: Florian Ragwitz <rafl@debian.org>
1953
1954 random: Roland Lammel <lammel@cpan.org>
1955
1956 Robert Sedlacek C<< <rs@474.at> >>
1957
1958 sky: Arthur Bergman
1959
1960 t0m: Tomas Doran <bobtfish@bobtfish.net>
1961
1962 Ulf Edvinsson
1963
1964 Viljo Marrandi C<vilts@yahoo.com>
1965
1966 Will Hawes C<info@whawes.co.uk>
1967
1968 willert: Sebastian Willert <willert@cpan.org>
1969
1970 Yuval Kogman, C<nothingmuch@woobling.org>
1971
1972 =head1 LICENSE
1973
1974 This library is free software. You can redistribute it and/or modify it under
1975 the same terms as Perl itself.
1976
1977 =cut
1978
1979 no Moose;
1980
1981 __PACKAGE__->meta->make_immutable;
1982
1983 1;