4 use base 'Catalyst::Base';
6 use UNIVERSAL::require;
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
16 use Time::HiRes qw/gettimeofday tv_interval/;
18 use Scalar::Util qw/weaken/;
20 __PACKAGE__->mk_accessors(qw/counter depth request response state/);
27 # For backwards compatibility
28 *finalize_output = \&finalize_body;
33 our $RECURSION = 1000;
34 our $DETACH = "catalyst_detach\n";
36 require Module::Pluggable::Fast;
38 # Helper script generation
39 our $CATALYST_SCRIPT_GEN = 8;
41 __PACKAGE__->mk_classdata($_)
42 for qw/components arguments dispatcher engine log/;
44 our $VERSION = '5.49_01';
47 my ( $class, @arguments ) = @_;
49 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
51 return unless $class eq 'Catalyst';
53 my $caller = caller(0);
55 unless ( $caller->isa('Catalyst') ) {
57 push @{"$caller\::ISA"}, $class;
60 $caller->arguments( [@arguments] );
66 Catalyst - The Elegant MVC Web Application Framework
70 # use the helper to start a new application
74 # add models, views, controllers
75 script/myapp_create.pl model Something
76 script/myapp_create.pl view Stuff
77 script/myapp_create.pl controller Yada
80 script/myapp_server.pl
82 # command line interface
83 script/myapp_test.pl /yada
88 use Catalyst qw/My::Module My::OtherModule/;
90 use Catalyst '-Debug';
92 use Catalyst qw/-Debug -Engine=CGI/;
94 sub default : Private { $_[1]->res->output('Hello') } );
96 sub index : Path('/index.html') {
97 my ( $self, $c ) = @_;
98 $c->res->output('Hello');
102 sub product : Regex('^product[_]*(\d*).html$') {
103 my ( $self, $c ) = @_;
104 $c->stash->{template} = 'product.tt';
105 $c->stash->{product} = $c->req->snippets->[0];
108 See also L<Catalyst::Manual::Intro>
112 The key concept of Catalyst is DRY (Don't Repeat Yourself).
114 See L<Catalyst::Manual> for more documentation.
116 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
117 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
118 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
120 use Catalyst 'My::Module';
122 Special flags like -Debug and -Engine can also be specified as arguments when
125 use Catalyst qw/-Debug My::Module/;
127 The position of plugins and flags in the chain is important, because they are
128 loaded in exactly the order that they appear.
130 The following flags are supported:
136 enables debug output, i.e.:
138 use Catalyst '-Debug';
140 this is equivalent to:
147 Force Catalyst to use a specific dispatcher.
151 Force Catalyst to use a specific engine.
152 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
154 use Catalyst '-Engine=CGI';
158 Force Catalyst to use a specific home directory.
170 =item $c->comp($name)
172 =item $c->component($name)
174 Get a component object by name.
176 $c->comp('MyApp::Model::MyModel')->do_stuff;
187 my $appclass = ref $c || $c;
190 $name, "${appclass}::${name}",
191 map { "${appclass}::${_}::${name}" } qw/M V C/
194 foreach my $try (@names) {
196 if ( exists $c->components->{$try} ) {
198 return $c->components->{$try};
202 foreach my $component ( keys %{ $c->components } ) {
204 return $c->components->{$component} if $component =~ /$name/i;
209 return sort keys %{ $c->components };
214 Returns a hashref containing your applications settings.
218 Overload to enable debug messages.
224 =item $c->detach( $command [, \@arguments ] )
226 Like C<forward> but doesn't return.
230 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
234 Contains the dispatcher instance.
235 Stringifies to class.
237 =item $c->forward( $command [, \@arguments ] )
239 Forward processing to a private action or a method from a class.
240 If you define a class without method it will default to process().
241 also takes an optional arrayref containing arguments to be passed
242 to the new function. $c->req->args will be reset upon returning
246 $c->forward('index');
247 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
248 $c->forward('MyApp::View::TT');
252 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
263 my ( $class, @arguments ) = @_;
265 unless ( $class->isa('Catalyst') ) {
267 Catalyst::Exception->throw(
268 message => qq/'$class' does not inherit from Catalyst/ );
271 if ( $class->arguments ) {
272 @arguments = ( @arguments, @{ $class->arguments } );
278 foreach (@arguments) {
282 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
284 elsif (/^-(\w+)=?(.*)$/) {
285 $flags->{ lc $1 } = $2;
288 push @{ $flags->{plugins} }, $_;
292 $class->setup_log( delete $flags->{log} );
293 $class->setup_plugins( delete $flags->{plugins} );
294 $class->setup_dispatcher( delete $flags->{dispatcher} );
295 $class->setup_engine( delete $flags->{engine} );
296 $class->setup_home( delete $flags->{home} );
298 for my $flag ( sort keys %{$flags} ) {
300 if ( my $code = $class->can( 'setup_' . $flag ) ) {
301 &$code( $class, delete $flags->{$flag} );
304 $class->log->warn(qq/Unknown flag "$flag"/);
308 $class->log->warn( "You are running an old helper script! "
309 . "Please update your scripts by regenerating the "
310 . "application and copying over the new scripts." )
311 if ( $ENV{CATALYST_SCRIPT_GEN}
312 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
314 if ( $class->debug ) {
320 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
324 my $t = Text::ASCIITable->new;
325 $t->setOptions( 'hide_HeadRow', 1 );
326 $t->setOptions( 'hide_HeadLine', 1 );
327 $t->setCols('Class');
328 $t->setColWidth( 'Class', 75, 1 );
329 $t->addRow($_) for @plugins;
330 $class->log->debug( "Loaded plugins:\n" . $t->draw );
333 my $dispatcher = $class->dispatcher;
334 my $engine = $class->engine;
335 my $home = $class->config->{home};
337 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
338 $class->log->debug(qq/Loaded engine "$engine"/);
342 ? $class->log->debug(qq/Found home "$home"/)
343 : $class->log->debug(qq/Home "$home" doesn't exist/)
344 : $class->log->debug(q/Couldn't find home/);
349 no warnings qw/redefine/;
350 local *setup = sub { };
354 # Initialize our data structure
355 $class->components( {} );
357 $class->setup_components;
359 if ( $class->debug ) {
360 my $t = Text::ASCIITable->new;
361 $t->setOptions( 'hide_HeadRow', 1 );
362 $t->setOptions( 'hide_HeadLine', 1 );
363 $t->setCols('Class');
364 $t->setColWidth( 'Class', 75, 1 );
365 $t->addRow($_) for sort keys %{ $class->components };
366 $class->log->debug( "Loaded components:\n" . $t->draw )
367 if ( @{ $t->{tbl_rows} } );
370 # Add our self to components, since we are also a component
371 $class->components->{$class} = $class;
373 $class->setup_actions;
375 if ( $class->debug ) {
376 my $name = $class->config->{name} || 'Application';
377 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
379 $class->log->_flush() if $class->log->can('_flush');
382 =item $c->uri_for($path)
384 Merges path with $c->request->base for absolute uri's and with
385 $c->request->match for relative uri's, then returns a normalized
391 my ( $c, $path ) = @_;
392 my $base = $c->request->base->clone;
393 my $basepath = $base->path;
394 $basepath =~ s/\/$//;
396 my $match = $c->request->match;
398 $match .= '/' if $match;
399 $match = '' if $path =~ /^\//;
401 return URI->new_abs( URI->new_abs( $path, "$basepath$match" ), $base )
407 =item $c->error($error, ...)
409 =item $c->error($arrayref)
411 Returns an arrayref containing error messages.
413 my @error = @{ $c->error };
417 $c->error('Something bad happened');
423 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
424 push @{ $c->{error} }, @$error;
430 Contains the engine instance.
431 Stringifies to the class.
435 Contains the logging object. Unless it is already set Catalyst sets this up with a
436 C<Catalyst::Log> object. To use your own log class:
438 $c->log( MyLogger->new );
439 $c->log->info("now logging with my own logger!");
441 Your log class should implement the methods described in the C<Catalyst::Log>
444 =item $c->plugin( $name, $class, @args )
446 Instant plugins for Catalyst.
447 Classdata accessor/mutator will be created, class loaded and instantiated.
449 MyApp->plugin( 'prototype', 'HTML::Prototype' );
451 $c->prototype->define_javascript_functions;
456 my ( $class, $name, $plugin, @args ) = @_;
459 if ( my $error = $UNIVERSAL::require::ERROR ) {
460 Catalyst::Exception->throw(
461 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
464 eval { $plugin->import };
465 $class->mk_classdata($name);
467 eval { $obj = $plugin->new(@args) };
470 Catalyst::Exception->throw( message =>
471 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
475 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
483 Returns a C<Catalyst::Request> object.
491 Returns a C<Catalyst::Response> object.
497 Contains the return value of the last executed action.
501 Returns a hashref containing all your data.
503 $c->stash->{foo} ||= 'yada';
504 print $c->stash->{foo};
511 my $stash = @_ > 1 ? {@_} : $_[0];
512 while ( my ( $key, $val ) = each %$stash ) {
513 $c->{stash}->{$key} = $val;
519 =head1 $c->welcome_message
521 Returns the Catalyst welcome HTML page.
525 sub welcome_message {
527 my $name = $c->config->{name};
531 <title>$name on Catalyst $VERSION</title>
532 <style type="text/css">
537 background-color: #eee;
545 background-color: #ccc;
546 border: 1px solid #aaa;
547 -moz-border-radius: 10px;
552 font-family: garamond, verdana, tahoma, sans-serif;
555 text-decoration: none;
557 border-bottom: 1px dotted #bbb;
559 :link:hover, :visited:hover {
560 background-color: #fff;
567 border: 1px dotted #555;
574 background-color: #fff;
575 border: 1px solid #aaa;
576 -moz-border-radius: 10px;
597 <h1>$name on Catalyst $VERSION</h1>
600 <p>Welcome to the wonderfull world of Catalyst.
601 This MVC framework will make webdevelopment
602 something you had never expected it to be:
603 Fun, rewarding and quick.</p>
604 <h2>What to do now?</h2>
605 <p>That all depends really, on what <b>you</b> want to do.
606 We do, however, provide you with a few starting points.</p>
607 <p>If you want to jump right into web development with Catalyst
608 you might want to check out the following links.</p>
611 <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">
616 <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">
617 Catalyst::Manual::Intro
621 <p>If you would like some background information on the
622 MVC-pattern, theese links might be able to help you out.</p>
625 <a href="http://dev.catalyst.perl.org/wiki/Models">
626 Introduction to Models
630 <a href="http://dev.catalyst.perl.org/wiki/Views">
631 Introduction to Views
635 <a href="http://dev.catalyst.perl.org/wiki/Controllers">
636 Introduction to Controllers
640 <p>You may also want to check the local installed
642 <pre><code>perldoc Catalyst::Manual
643 perldoc Catalyst::Manual::Intro</code></pre>
644 <h2>What to do next?</h2>
645 <p>Next you need to create an actuall application. Use the
646 helper scripts for what they are worth, they can save you
647 alot of work getting everything set up. Also, be sure to
648 check out the vast array of plugins for Catalyst.
649 They can handle everything from Authentication to Static
650 files, and a whole lot in between.</p>
651 <h2>In conclusion</h2>
652 <p>The Catalyst team hope you will enjoy Catalyst as much as we enjoyed making it, and that rest asure that any and all
653 feedback is welcomed</p>
654 <p class="signature">-- there is no cabal, 2005</p>
664 =head1 INTERNAL METHODS
668 =item $c->benchmark($coderef)
670 Takes a coderef with arguments and returns elapsed time as float.
672 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
673 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
680 my $time = [gettimeofday];
681 my @return = &$code(@_);
682 my $elapsed = tv_interval $time;
683 return wantarray ? ( $elapsed, @return ) : $elapsed;
688 Contains the components.
692 Returns a hashref containing coderefs and execution counts.
693 (Needed for deep recursion detection)
697 Returns the actual forward depth.
701 Dispatch request to actions.
705 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
707 =item $c->execute($class, $coderef)
709 Execute a coderef in given class and catch exceptions.
710 Errors are available via $c->error.
715 my ( $c, $class, $code ) = @_;
716 $class = $c->components->{$class} || $class;
718 my $callsub = ( caller(1) )[3];
723 $action = "/$action" unless $action =~ /\-\>/;
724 $c->counter->{"$code"}++;
726 if ( $c->counter->{"$code"} > $RECURSION ) {
727 my $error = qq/Deep recursion detected in "$action"/;
728 $c->log->error($error);
734 $action = "-> $action" if $callsub =~ /forward$/;
740 my ( $elapsed, @state ) =
741 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
742 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
745 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
749 if ( my $error = $@ ) {
751 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
753 unless ( ref $error ) {
755 $error = qq/Caught exception "$error"/;
758 $c->log->error($error);
775 $c->finalize_uploads;
778 if ( $#{ $c->error } >= 0 ) {
782 $c->finalize_headers;
785 if ( $c->request->method eq 'HEAD' ) {
786 $c->response->body('');
791 return $c->response->status;
794 =item $c->finalize_body
800 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
802 =item $c->finalize_cookies
808 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
810 =item $c->finalize_error
816 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
818 =item $c->finalize_headers
824 sub finalize_headers {
827 # Check if we already finalized headers
828 return if $c->response->{_finalized_headers};
831 if ( my $location = $c->response->redirect ) {
832 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
833 $c->response->header( Location => $location );
837 if ( $c->response->body && !$c->response->content_length ) {
838 $c->response->content_length( bytes::length( $c->response->body ) );
842 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
843 $c->response->headers->remove_header("Content-Length");
844 $c->response->body('');
847 $c->finalize_cookies;
849 $c->engine->finalize_headers( $c, @_ );
852 $c->response->{_finalized_headers} = 1;
855 =item $c->finalize_output
857 An alias for finalize_body.
859 =item $c->finalize_read
861 Finalize the input after reading is complete.
865 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
867 =item $c->finalize_uploads
869 Finalize uploads. Cleans up any temporary files.
873 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
875 =item $c->get_action( $action, $namespace, $inherit )
877 Get an action in a given namespace.
881 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
883 =item handle_request( $class, @arguments )
890 my ( $class, @arguments ) = @_;
892 # Always expect worst case!
898 my $c = $class->prepare(@arguments);
899 $c->{stats} = \@stats;
904 if ( $class->debug ) {
906 ( $elapsed, $status ) = $class->benchmark($handler);
907 $elapsed = sprintf '%f', $elapsed;
908 my $av = sprintf '%.3f',
909 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
910 my $t = Text::ASCIITable->new;
911 $t->setCols( 'Action', 'Time' );
912 $t->setColWidth( 'Action', 64, 1 );
913 $t->setColWidth( 'Time', 9, 1 );
915 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
917 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
919 else { $status = &$handler }
923 if ( my $error = $@ ) {
925 $class->log->error(qq/Caught exception in engine "$error"/);
929 $class->log->_flush() if $class->log->can('_flush');
933 =item $c->prepare(@arguments)
935 Turns the engine-specific request( Apache, CGI ... )
936 into a Catalyst context .
941 my ( $class, @arguments ) = @_;
946 request => Catalyst::Request->new(
949 body_parameters => {},
951 headers => HTTP::Headers->new,
953 query_parameters => {},
959 response => Catalyst::Response->new(
963 headers => HTTP::Headers->new(),
972 $c->request->{_context} = $c;
973 $c->response->{_context} = $c;
974 weaken( $c->request->{_context} );
975 weaken( $c->response->{_context} );
978 my $secs = time - $START || 1;
979 my $av = sprintf '%.3f', $COUNT / $secs;
980 $c->log->debug('**********************************');
981 $c->log->debug("* Request $COUNT ($av/s) [$$]");
982 $c->log->debug('**********************************');
983 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
986 $c->prepare_request(@arguments);
987 $c->prepare_connection;
988 $c->prepare_query_parameters;
994 $c->prepare_body unless $c->config->{parse_on_demand};
997 my $method = $c->req->method || '';
998 my $path = $c->req->path || '';
999 my $address = $c->req->address || '';
1001 $c->log->debug(qq/"$method" request for "$path" from $address/)
1007 =item $c->prepare_action
1013 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1015 =item $c->prepare_body
1017 Prepare message body.
1024 # Do we run for the first time?
1025 return if defined $c->request->{_body};
1027 # Initialize on-demand data
1028 $c->engine->prepare_body( $c, @_ );
1029 $c->prepare_parameters;
1030 $c->prepare_uploads;
1032 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1033 my $t = Text::ASCIITable->new;
1034 $t->setCols( 'Key', 'Value' );
1035 $t->setColWidth( 'Key', 37, 1 );
1036 $t->setColWidth( 'Value', 36, 1 );
1037 $t->alignCol( 'Value', 'right' );
1038 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1039 my $param = $c->req->body_parameters->{$key};
1040 my $value = defined($param) ? $param : '';
1042 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1044 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1048 =item $c->prepare_body_chunk( $chunk )
1050 Prepare a chunk of data before sending it to HTTP::Body.
1054 sub prepare_body_chunk {
1056 $c->engine->prepare_body_chunk( $c, @_ );
1059 =item $c->prepare_body_parameters
1061 Prepare body parameters.
1065 sub prepare_body_parameters {
1067 $c->engine->prepare_body_parameters( $c, @_ );
1070 =item $c->prepare_connection
1076 sub prepare_connection {
1078 $c->engine->prepare_connection( $c, @_ );
1081 =item $c->prepare_cookies
1087 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1089 =item $c->prepare_headers
1095 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1097 =item $c->prepare_parameters
1103 sub prepare_parameters {
1105 $c->prepare_body_parameters;
1106 $c->engine->prepare_parameters( $c, @_ );
1109 =item $c->prepare_path
1111 Prepare path and base.
1115 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1117 =item $c->prepare_query_parameters
1119 Prepare query parameters.
1123 sub prepare_query_parameters {
1126 $c->engine->prepare_query_parameters( $c, @_ );
1128 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1129 my $t = Text::ASCIITable->new;
1130 $t->setCols( 'Key', 'Value' );
1131 $t->setColWidth( 'Key', 37, 1 );
1132 $t->setColWidth( 'Value', 36, 1 );
1133 $t->alignCol( 'Value', 'right' );
1134 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1135 my $param = $c->req->query_parameters->{$key};
1136 my $value = defined($param) ? $param : '';
1138 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1140 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1144 =item $c->prepare_read
1146 Prepare the input for reading.
1150 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1152 =item $c->prepare_request
1154 Prepare the engine request.
1158 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1160 =item $c->prepare_uploads
1166 sub prepare_uploads {
1169 $c->engine->prepare_uploads( $c, @_ );
1171 if ( $c->debug && keys %{ $c->request->uploads } ) {
1172 my $t = Text::ASCIITable->new;
1173 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1174 $t->setColWidth( 'Key', 12, 1 );
1175 $t->setColWidth( 'Filename', 28, 1 );
1176 $t->setColWidth( 'Type', 18, 1 );
1177 $t->setColWidth( 'Size', 9, 1 );
1178 $t->alignCol( 'Size', 'left' );
1179 for my $key ( sort keys %{ $c->request->uploads } ) {
1180 my $upload = $c->request->uploads->{$key};
1181 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1182 $t->addRow( $key, $u->filename, $u->type, $u->size );
1185 $c->log->debug( "File Uploads are:\n" . $t->draw );
1189 =item $c->prepare_write
1191 Prepare the output for writing.
1195 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1197 =item $c->read( [$maxlength] )
1199 Read a chunk of data from the request body. This method is designed to be
1200 used in a while loop, reading $maxlength bytes on every call. $maxlength
1201 defaults to the size of the request if not specified.
1203 You have to set MyApp->config->{parse_on_demand} to use this directly.
1207 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1215 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1217 =item $c->set_action( $action, $code, $namespace, $attrs )
1219 Set an action in a given namespace.
1223 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1225 =item $c->setup_actions($component)
1227 Setup actions for a component.
1231 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1233 =item $c->setup_components
1239 sub setup_components {
1242 my $callback = sub {
1243 my ( $component, $context ) = @_;
1245 unless ( $component->isa('Catalyst::Base') ) {
1249 my $suffix = Catalyst::Utils::class2classsuffix($component);
1250 my $config = $class->config->{$suffix} || {};
1254 eval { $instance = $component->new( $context, $config ); };
1256 if ( my $error = $@ ) {
1260 Catalyst::Exception->throw( message =>
1261 qq/Couldn't instantiate component "$component", "$error"/ );
1264 Catalyst::Exception->throw( message =>
1265 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1267 unless ref $instance;
1272 Module::Pluggable::Fast->import(
1273 name => '_catalyst_components',
1275 "$class\::Controller", "$class\::C",
1276 "$class\::Model", "$class\::M",
1277 "$class\::View", "$class\::V"
1279 callback => $callback
1283 if ( my $error = $@ ) {
1287 Catalyst::Exception->throw(
1288 message => qq/Couldn't load components "$error"/ );
1291 for my $component ( $class->_catalyst_components($class) ) {
1292 $class->components->{ ref $component || $component } = $component;
1296 =item $c->setup_dispatcher
1300 sub setup_dispatcher {
1301 my ( $class, $dispatcher ) = @_;
1304 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1307 if ( $ENV{CATALYST_DISPATCHER} ) {
1308 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1311 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1313 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1316 unless ($dispatcher) {
1317 $dispatcher = 'Catalyst::Dispatcher';
1320 $dispatcher->require;
1323 Catalyst::Exception->throw(
1324 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1327 # dispatcher instance
1328 $class->dispatcher( $dispatcher->new );
1331 =item $c->setup_engine
1336 my ( $class, $engine ) = @_;
1339 $engine = 'Catalyst::Engine::' . $engine;
1342 if ( $ENV{CATALYST_ENGINE} ) {
1343 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1346 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1347 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1350 if ( !$engine && $ENV{MOD_PERL} ) {
1352 # create the apache method
1355 *{"$class\::apache"} = sub { shift->engine->apache };
1358 my ( $software, $version ) =
1359 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1362 $version =~ s/(\.[^.]+)\./$1/g;
1364 if ( $software eq 'mod_perl' ) {
1366 if ( $version >= 1.99922 ) {
1367 $engine = 'Catalyst::Engine::Apache2::MP20';
1370 elsif ( $version >= 1.9901 ) {
1371 $engine = 'Catalyst::Engine::Apache2::MP19';
1374 elsif ( $version >= 1.24 ) {
1375 $engine = 'Catalyst::Engine::Apache::MP13';
1379 Catalyst::Exception->throw( message =>
1380 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1383 # install the correct mod_perl handler
1384 if ( $version >= 1.9901 ) {
1385 *handler = sub : method {
1386 shift->handle_request(@_);
1390 *handler = sub ($$) { shift->handle_request(@_) };
1395 elsif ( $software eq 'Zeus-Perl' ) {
1396 $engine = 'Catalyst::Engine::Zeus';
1400 Catalyst::Exception->throw(
1401 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1406 $engine = 'Catalyst::Engine::CGI';
1412 Catalyst::Exception->throw( message =>
1413 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1418 $class->engine( $engine->new );
1421 =item $c->setup_home
1426 my ( $class, $home ) = @_;
1428 if ( $ENV{CATALYST_HOME} ) {
1429 $home = $ENV{CATALYST_HOME};
1432 if ( $ENV{ uc($class) . '_HOME' } ) {
1433 $home = $ENV{ uc($class) . '_HOME' };
1437 $home = Catalyst::Utils::home($class);
1441 $class->config->{home} ||= $home;
1442 $class->config->{root} ||= dir($home)->subdir('root');
1451 my ( $class, $debug ) = @_;
1453 unless ( $class->log ) {
1454 $class->log( Catalyst::Log->new );
1457 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1459 *{"$class\::debug"} = sub { 1 };
1460 $class->log->debug('Debug messages enabled');
1464 =item $c->setup_plugins
1469 my ( $class, $plugins ) = @_;
1472 for my $plugin ( reverse @$plugins ) {
1474 $plugin = "Catalyst::Plugin::$plugin";
1479 Catalyst::Exception->throw(
1480 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1485 unshift @{"$class\::ISA"}, $plugin;
1490 =item $c->write( $data )
1492 Writes $data to the output stream. When using this method directly, you will
1493 need to manually set the Content-Length header to the length of your output
1501 # Finalize headers if someone manually writes output
1502 $c->finalize_headers;
1504 return $c->engine->write( $c, @_ );
1509 =head1 CASE SENSITIVITY
1511 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1514 But you can activate case sensitivity with a config parameter.
1516 MyApp->config->{case_sensitive} = 1;
1518 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1520 =head1 ON-DEMAND PARSER
1522 The request body is usually parsed at the beginning of a request,
1523 but if you want to handle input yourself or speed things up a bit
1524 you can enable on-demand parsing with a config parameter.
1526 MyApp->config->{parse_on_demand} = 1;
1528 =head1 PROXY SUPPORT
1530 Many production servers operate using the common double-server approach, with
1531 a lightweight frontend web server passing requests to a larger backend
1532 server. An application running on the backend server must deal with two
1533 problems: the remote user always appears to be '127.0.0.1' and the server's
1534 hostname will appear to be 'localhost' regardless of the virtual host the
1535 user connected through.
1537 Catalyst will automatically detect this situation when you are running both
1538 the frontend and backend servers on the same machine. The following changes
1539 are made to the request.
1541 $c->req->address is set to the user's real IP address, as read from the
1542 HTTP_X_FORWARDED_FOR header.
1544 The host value for $c->req->base and $c->req->uri is set to the real host,
1545 as read from the HTTP_X_FORWARDED_HOST header.
1547 Obviously, your web server must support these 2 headers for this to work.
1549 In a more complex server farm environment where you may have your frontend
1550 proxy server(s) on different machines, you will need to set a configuration
1551 option to tell Catalyst to read the proxied data from the headers.
1553 MyApp->config->{using_frontend_proxy} = 1;
1555 If you do not wish to use the proxy support at all, you may set:
1557 MyApp->config->{ignore_frontend_proxy} = 1;
1559 =head1 THREAD SAFETY
1561 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1562 and the standalone forking HTTP server on Windows. We believe the Catalyst
1563 core to be thread-safe.
1565 If you plan to operate in a threaded environment, remember that all other
1566 modules you are using must also be thread-safe. Some modules, most notably
1567 DBD::SQLite, are not thread-safe.
1573 Join #catalyst on irc.perl.org.
1577 http://lists.rawmode.org/mailman/listinfo/catalyst
1578 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1582 http://catalyst.perl.org
1588 =item L<Catalyst::Manual> - The Catalyst Manual
1590 =item L<Catalyst::Engine> - Core Engine
1592 =item L<Catalyst::Log> - The Log Class.
1594 =item L<Catalyst::Request> - The Request Object
1596 =item L<Catalyst::Response> - The Response Object
1598 =item L<Catalyst::Test> - The test suite.
1656 Sebastian Riedel, C<sri@oook.de>
1660 This library is free software . You can redistribute it and/or modify it under
1661 the same terms as perl itself.