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 = 7;
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;
521 =head1 INTERNAL METHODS
525 =item $c->benchmark($coderef)
527 Takes a coderef with arguments and returns elapsed time as float.
529 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
530 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
537 my $time = [gettimeofday];
538 my @return = &$code(@_);
539 my $elapsed = tv_interval $time;
540 return wantarray ? ( $elapsed, @return ) : $elapsed;
545 Contains the components.
549 Returns a hashref containing coderefs and execution counts.
550 (Needed for deep recursion detection)
554 Returns the actual forward depth.
558 Dispatch request to actions.
562 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
564 =item $c->execute($class, $coderef)
566 Execute a coderef in given class and catch exceptions.
567 Errors are available via $c->error.
572 my ( $c, $class, $code ) = @_;
573 $class = $c->components->{$class} || $class;
575 my $callsub = ( caller(1) )[3];
580 $action = "/$action" unless $action =~ /\-\>/;
581 $c->counter->{"$code"}++;
583 if ( $c->counter->{"$code"} > $RECURSION ) {
584 my $error = qq/Deep recursion detected in "$action"/;
585 $c->log->error($error);
591 $action = "-> $action" if $callsub =~ /forward$/;
597 my ( $elapsed, @state ) =
598 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
599 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
602 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
606 if ( my $error = $@ ) {
608 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
610 unless ( ref $error ) {
612 $error = qq/Caught exception "$error"/;
615 $c->log->error($error);
632 $c->finalize_uploads;
635 if ( $#{ $c->error } >= 0 ) {
639 $c->finalize_headers;
642 if ( $c->request->method eq 'HEAD' ) {
643 $c->response->body('');
648 return $c->response->status;
651 =item $c->finalize_body
657 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
659 =item $c->finalize_cookies
665 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
667 =item $c->finalize_error
673 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
675 =item $c->finalize_headers
681 sub finalize_headers {
684 # Check if we already finalized headers
685 return if $c->response->{_finalized_headers};
688 if ( my $location = $c->response->redirect ) {
689 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
690 $c->response->header( Location => $location );
694 if ( $c->response->body && !$c->response->content_length ) {
695 $c->response->content_length( bytes::length( $c->response->body ) );
699 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
700 $c->response->headers->remove_header("Content-Length");
701 $c->response->body('');
704 $c->finalize_cookies;
706 $c->engine->finalize_headers( $c, @_ );
709 $c->response->{_finalized_headers} = 1;
712 =item $c->finalize_output
714 An alias for finalize_body.
716 =item $c->finalize_read
718 Finalize the input after reading is complete.
722 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
724 =item $c->finalize_uploads
726 Finalize uploads. Cleans up any temporary files.
730 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
732 =item $c->get_action( $action, $namespace, $inherit )
734 Get an action in a given namespace.
738 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
740 =item handle_request( $class, @arguments )
747 my ( $class, @arguments ) = @_;
749 # Always expect worst case!
755 my $c = $class->prepare(@arguments);
756 $c->{stats} = \@stats;
761 if ( $class->debug ) {
763 ( $elapsed, $status ) = $class->benchmark($handler);
764 $elapsed = sprintf '%f', $elapsed;
765 my $av = sprintf '%.3f',
766 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
767 my $t = Text::ASCIITable->new;
768 $t->setCols( 'Action', 'Time' );
769 $t->setColWidth( 'Action', 64, 1 );
770 $t->setColWidth( 'Time', 9, 1 );
772 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
774 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
776 else { $status = &$handler }
780 if ( my $error = $@ ) {
782 $class->log->error(qq/Caught exception in engine "$error"/);
786 $class->log->_flush() if $class->log->can('_flush');
790 =item $c->prepare(@arguments)
792 Turns the engine-specific request( Apache, CGI ... )
793 into a Catalyst context .
798 my ( $class, @arguments ) = @_;
803 request => Catalyst::Request->new(
806 body_parameters => {},
808 headers => HTTP::Headers->new,
810 query_parameters => {},
816 response => Catalyst::Response->new(
820 headers => HTTP::Headers->new(),
829 $c->request->{_context} = $c;
830 $c->response->{_context} = $c;
831 weaken( $c->request->{_context} );
832 weaken( $c->response->{_context} );
835 my $secs = time - $START || 1;
836 my $av = sprintf '%.3f', $COUNT / $secs;
837 $c->log->debug('**********************************');
838 $c->log->debug("* Request $COUNT ($av/s) [$$]");
839 $c->log->debug('**********************************');
840 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
843 $c->prepare_request(@arguments);
844 $c->prepare_connection;
845 $c->prepare_query_parameters;
851 $c->prepare_body unless $c->config->{parse_on_demand};
854 my $method = $c->req->method || '';
855 my $path = $c->req->path || '';
856 my $address = $c->req->address || '';
858 $c->log->debug(qq/"$method" request for "$path" from $address/)
864 =item $c->prepare_action
870 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
872 =item $c->prepare_body
874 Prepare message body.
881 # Do we run for the first time?
882 return if defined $c->request->{_body};
884 # Initialize on-demand data
885 $c->engine->prepare_body( $c, @_ );
886 $c->prepare_parameters;
889 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
890 my $t = Text::ASCIITable->new;
891 $t->setCols( 'Key', 'Value' );
892 $t->setColWidth( 'Key', 37, 1 );
893 $t->setColWidth( 'Value', 36, 1 );
894 $t->alignCol( 'Value', 'right' );
895 for my $key ( sort keys %{ $c->req->body_parameters } ) {
896 my $param = $c->req->body_parameters->{$key};
897 my $value = defined($param) ? $param : '';
899 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
901 $c->log->debug( "Body Parameters are:\n" . $t->draw );
905 =item $c->prepare_body_chunk( $chunk )
907 Prepare a chunk of data before sending it to HTTP::Body.
911 sub prepare_body_chunk {
913 $c->engine->prepare_body_chunk( $c, @_ );
916 =item $c->prepare_body_parameters
918 Prepare body parameters.
922 sub prepare_body_parameters {
924 $c->engine->prepare_body_parameters( $c, @_ );
927 =item $c->prepare_connection
933 sub prepare_connection {
935 $c->engine->prepare_connection( $c, @_ );
938 =item $c->prepare_cookies
944 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
946 =item $c->prepare_headers
952 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
954 =item $c->prepare_parameters
960 sub prepare_parameters {
962 $c->prepare_body_parameters;
963 $c->engine->prepare_parameters( $c, @_ );
966 =item $c->prepare_path
968 Prepare path and base.
972 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
974 =item $c->prepare_query_parameters
976 Prepare query parameters.
980 sub prepare_query_parameters {
983 $c->engine->prepare_query_parameters( $c, @_ );
985 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
986 my $t = Text::ASCIITable->new;
987 $t->setCols( 'Key', 'Value' );
988 $t->setColWidth( 'Key', 37, 1 );
989 $t->setColWidth( 'Value', 36, 1 );
990 $t->alignCol( 'Value', 'right' );
991 for my $key ( sort keys %{ $c->req->query_parameters } ) {
992 my $param = $c->req->query_parameters->{$key};
993 my $value = defined($param) ? $param : '';
995 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
997 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1001 =item $c->prepare_read
1003 Prepare the input for reading.
1007 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1009 =item $c->prepare_request
1011 Prepare the engine request.
1015 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1017 =item $c->prepare_uploads
1023 sub prepare_uploads {
1026 $c->engine->prepare_uploads( $c, @_ );
1028 if ( $c->debug && keys %{ $c->request->uploads } ) {
1029 my $t = Text::ASCIITable->new;
1030 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1031 $t->setColWidth( 'Key', 12, 1 );
1032 $t->setColWidth( 'Filename', 28, 1 );
1033 $t->setColWidth( 'Type', 18, 1 );
1034 $t->setColWidth( 'Size', 9, 1 );
1035 $t->alignCol( 'Size', 'left' );
1036 for my $key ( sort keys %{ $c->request->uploads } ) {
1037 my $upload = $c->request->uploads->{$key};
1038 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1039 $t->addRow( $key, $u->filename, $u->type, $u->size );
1042 $c->log->debug( "File Uploads are:\n" . $t->draw );
1046 =item $c->prepare_write
1048 Prepare the output for writing.
1052 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1054 =item $c->read( [$maxlength] )
1056 Read a chunk of data from the request body. This method is designed to be
1057 used in a while loop, reading $maxlength bytes on every call. $maxlength
1058 defaults to the size of the request if not specified.
1060 You have to set MyApp->config->{parse_on_demand} to use this directly.
1064 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1072 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1074 =item $c->set_action( $action, $code, $namespace, $attrs )
1076 Set an action in a given namespace.
1080 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1082 =item $c->setup_actions($component)
1084 Setup actions for a component.
1088 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1090 =item $c->setup_components
1096 sub setup_components {
1099 my $callback = sub {
1100 my ( $component, $context ) = @_;
1102 unless ( $component->isa('Catalyst::Base') ) {
1106 my $suffix = Catalyst::Utils::class2classsuffix($component);
1107 my $config = $class->config->{$suffix} || {};
1111 eval { $instance = $component->new( $context, $config ); };
1113 if ( my $error = $@ ) {
1117 Catalyst::Exception->throw( message =>
1118 qq/Couldn't instantiate component "$component", "$error"/ );
1121 Catalyst::Exception->throw( message =>
1122 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1124 unless ref $instance;
1129 Module::Pluggable::Fast->import(
1130 name => '_catalyst_components',
1132 "$class\::Controller", "$class\::C",
1133 "$class\::Model", "$class\::M",
1134 "$class\::View", "$class\::V"
1136 callback => $callback
1140 if ( my $error = $@ ) {
1144 Catalyst::Exception->throw(
1145 message => qq/Couldn't load components "$error"/ );
1148 for my $component ( $class->_catalyst_components($class) ) {
1149 $class->components->{ ref $component || $component } = $component;
1153 =item $c->setup_dispatcher
1157 sub setup_dispatcher {
1158 my ( $class, $dispatcher ) = @_;
1161 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1164 if ( $ENV{CATALYST_DISPATCHER} ) {
1165 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1168 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1170 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1173 unless ($dispatcher) {
1174 $dispatcher = 'Catalyst::Dispatcher';
1177 $dispatcher->require;
1180 Catalyst::Exception->throw(
1181 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1184 # dispatcher instance
1185 $class->dispatcher( $dispatcher->new );
1188 =item $c->setup_engine
1193 my ( $class, $engine ) = @_;
1196 $engine = 'Catalyst::Engine::' . $engine;
1199 if ( $ENV{CATALYST_ENGINE} ) {
1200 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1203 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1204 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1207 if ( !$engine && $ENV{MOD_PERL} ) {
1209 # create the apache method
1212 *{"$class\::apache"} = sub { shift->engine->apache };
1215 my ( $software, $version ) =
1216 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1219 $version =~ s/(\.[^.]+)\./$1/g;
1221 if ( $software eq 'mod_perl' ) {
1223 if ( $version >= 1.99922 ) {
1224 $engine = 'Catalyst::Engine::Apache2::MP20';
1227 elsif ( $version >= 1.9901 ) {
1228 $engine = 'Catalyst::Engine::Apache2::MP19';
1231 elsif ( $version >= 1.24 ) {
1232 $engine = 'Catalyst::Engine::Apache::MP13';
1236 Catalyst::Exception->throw( message =>
1237 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1240 # install the correct mod_perl handler
1241 if ( $version >= 1.9901 ) {
1242 *handler = sub : method {
1243 shift->handle_request(@_);
1247 *handler = sub ($$) { shift->handle_request(@_) };
1252 elsif ( $software eq 'Zeus-Perl' ) {
1253 $engine = 'Catalyst::Engine::Zeus';
1257 Catalyst::Exception->throw(
1258 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1263 $engine = 'Catalyst::Engine::CGI';
1269 Catalyst::Exception->throw( message =>
1270 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1275 $class->engine( $engine->new );
1278 =item $c->setup_home
1283 my ( $class, $home ) = @_;
1285 if ( $ENV{CATALYST_HOME} ) {
1286 $home = $ENV{CATALYST_HOME};
1289 if ( $ENV{ uc($class) . '_HOME' } ) {
1290 $home = $ENV{ uc($class) . '_HOME' };
1294 $home = Catalyst::Utils::home($class);
1298 $class->config->{home} ||= $home;
1299 $class->config->{root} ||= dir($home)->subdir('root');
1308 my ( $class, $debug ) = @_;
1310 unless ( $class->log ) {
1311 $class->log( Catalyst::Log->new );
1314 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1316 *{"$class\::debug"} = sub { 1 };
1317 $class->log->debug('Debug messages enabled');
1321 =item $c->setup_plugins
1326 my ( $class, $plugins ) = @_;
1329 for my $plugin ( reverse @$plugins ) {
1331 $plugin = "Catalyst::Plugin::$plugin";
1336 Catalyst::Exception->throw(
1337 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1342 unshift @{"$class\::ISA"}, $plugin;
1347 =item $c->write( $data )
1349 Writes $data to the output stream. When using this method directly, you will
1350 need to manually set the Content-Length header to the length of your output
1358 # Finalize headers if someone manually writes output
1359 $c->finalize_headers;
1361 return $c->engine->write( $c, @_ );
1366 =head1 CASE SENSITIVITY
1368 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1371 But you can activate case sensitivity with a config parameter.
1373 MyApp->config->{case_sensitive} = 1;
1375 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1377 =head1 ON-DEMAND PARSER
1379 The request body is usually parsed at the beginning of a request,
1380 but if you want to handle input yourself or speed things up a bit
1381 you can enable on-demand parsing with a config parameter.
1383 MyApp->config->{parse_on_demand} = 1;
1385 =head1 PROXY SUPPORT
1387 Many production servers operate using the common double-server approach, with
1388 a lightweight frontend web server passing requests to a larger backend
1389 server. An application running on the backend server must deal with two
1390 problems: the remote user always appears to be '127.0.0.1' and the server's
1391 hostname will appear to be 'localhost' regardless of the virtual host the
1392 user connected through.
1394 Catalyst will automatically detect this situation when you are running both
1395 the frontend and backend servers on the same machine. The following changes
1396 are made to the request.
1398 $c->req->address is set to the user's real IP address, as read from the
1399 HTTP_X_FORWARDED_FOR header.
1401 The host value for $c->req->base and $c->req->uri is set to the real host,
1402 as read from the HTTP_X_FORWARDED_HOST header.
1404 Obviously, your web server must support these 2 headers for this to work.
1406 In a more complex server farm environment where you may have your frontend
1407 proxy server(s) on different machines, you will need to set a configuration
1408 option to tell Catalyst to read the proxied data from the headers.
1410 MyApp->config->{using_frontend_proxy} = 1;
1412 If you do not wish to use the proxy support at all, you may set:
1414 MyApp->config->{ignore_frontend_proxy} = 1;
1416 =head1 THREAD SAFETY
1418 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1419 and the standalone forking HTTP server on Windows. We believe the Catalyst
1420 core to be thread-safe.
1422 If you plan to operate in a threaded environment, remember that all other
1423 modules you are using must also be thread-safe. Some modules, most notably
1424 DBD::SQLite, are not thread-safe.
1430 Join #catalyst on irc.perl.org.
1434 http://lists.rawmode.org/mailman/listinfo/catalyst
1435 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1439 http://catalyst.perl.org
1445 =item L<Catalyst::Manual> - The Catalyst Manual
1447 =item L<Catalyst::Engine> - Core Engine
1449 =item L<Catalyst::Log> - The Log Class.
1451 =item L<Catalyst::Request> - The Request Object
1453 =item L<Catalyst::Response> - The Response Object
1455 =item L<Catalyst::Test> - The test suite.
1513 Sebastian Riedel, C<sri@oook.de>
1517 This library is free software . You can redistribute it and/or modify it under
1518 the same terms as perl itself.