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