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