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