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