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(
21 qw/counter depth request response state action namespace/
29 # For backwards compatibility
30 *finalize_output = \&finalize_body;
35 our $RECURSION = 1000;
36 our $DETACH = "catalyst_detach\n";
38 require Module::Pluggable::Fast;
40 # Helper script generation
41 our $CATALYST_SCRIPT_GEN = 8;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_01';
49 my ( $class, @arguments ) = @_;
51 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
53 return unless $class eq 'Catalyst';
55 my $caller = caller(0);
57 unless ( $caller->isa('Catalyst') ) {
59 push @{"$caller\::ISA"}, $class;
62 $caller->arguments( [@arguments] );
68 Catalyst - The Elegant MVC Web Application Framework
72 # use the helper to start a new application
76 # add models, views, controllers
77 script/myapp_create.pl model Something
78 script/myapp_create.pl view Stuff
79 script/myapp_create.pl controller Yada
82 script/myapp_server.pl
84 # command line interface
85 script/myapp_test.pl /yada
90 use Catalyst qw/My::Module My::OtherModule/;
92 use Catalyst '-Debug';
94 use Catalyst qw/-Debug -Engine=CGI/;
96 sub default : Private { $_[1]->res->output('Hello') } );
98 sub index : Path('/index.html') {
99 my ( $self, $c ) = @_;
100 $c->res->output('Hello');
104 sub product : Regex('^product[_]*(\d*).html$') {
105 my ( $self, $c ) = @_;
106 $c->stash->{template} = 'product.tt';
107 $c->stash->{product} = $c->req->snippets->[0];
110 See also L<Catalyst::Manual::Intro>
114 The key concept of Catalyst is DRY (Don't Repeat Yourself).
116 See L<Catalyst::Manual> for more documentation.
118 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
119 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
120 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
122 use Catalyst 'My::Module';
124 Special flags like -Debug and -Engine can also be specified as arguments when
127 use Catalyst qw/-Debug My::Module/;
129 The position of plugins and flags in the chain is important, because they are
130 loaded in exactly the order that they appear.
132 The following flags are supported:
138 enables debug output, i.e.:
140 use Catalyst '-Debug';
142 this is equivalent to:
149 Force Catalyst to use a specific dispatcher.
153 Force Catalyst to use a specific engine.
154 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
156 use Catalyst '-Engine=CGI';
160 Force Catalyst to use a specific home directory.
174 Accessor for the current action
176 =item $c->comp($name)
178 =item $c->component($name)
180 Get a component object by name.
182 $c->comp('MyApp::Model::MyModel')->do_stuff;
193 my $appclass = ref $c || $c;
196 $name, "${appclass}::${name}",
197 map { "${appclass}::${_}::${name}" } qw/M V C/
200 foreach my $try (@names) {
202 if ( exists $c->components->{$try} ) {
204 return $c->components->{$try};
208 foreach my $component ( keys %{ $c->components } ) {
210 return $c->components->{$component} if $component =~ /$name/i;
215 return sort keys %{ $c->components };
220 Returns a hashref containing your applications settings.
224 Overload to enable debug messages.
230 =item $c->detach( $command [, \@arguments ] )
232 Like C<forward> but doesn't return.
236 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
240 Contains the dispatcher instance.
241 Stringifies to class.
243 =item $c->forward( $command [, \@arguments ] )
245 Forward processing to a private action or a method from a class.
246 If you define a class without method it will default to process().
247 also takes an optional arrayref containing arguments to be passed
248 to the new function. $c->req->args will be reset upon returning
252 $c->forward('index');
253 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
254 $c->forward('MyApp::View::TT');
258 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
262 Accessor to the namespace of the current action
273 my ( $class, @arguments ) = @_;
275 unless ( $class->isa('Catalyst') ) {
277 Catalyst::Exception->throw(
278 message => qq/'$class' does not inherit from Catalyst/ );
281 if ( $class->arguments ) {
282 @arguments = ( @arguments, @{ $class->arguments } );
288 foreach (@arguments) {
292 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
294 elsif (/^-(\w+)=?(.*)$/) {
295 $flags->{ lc $1 } = $2;
298 push @{ $flags->{plugins} }, $_;
302 $class->setup_log( delete $flags->{log} );
303 $class->setup_plugins( delete $flags->{plugins} );
304 $class->setup_dispatcher( delete $flags->{dispatcher} );
305 $class->setup_engine( delete $flags->{engine} );
306 $class->setup_home( delete $flags->{home} );
308 for my $flag ( sort keys %{$flags} ) {
310 if ( my $code = $class->can( 'setup_' . $flag ) ) {
311 &$code( $class, delete $flags->{$flag} );
314 $class->log->warn(qq/Unknown flag "$flag"/);
318 $class->log->warn( "You are running an old helper script! "
319 . "Please update your scripts by regenerating the "
320 . "application and copying over the new scripts." )
321 if ( $ENV{CATALYST_SCRIPT_GEN}
322 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
324 if ( $class->debug ) {
330 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
334 my $t = Text::ASCIITable->new;
335 $t->setOptions( 'hide_HeadRow', 1 );
336 $t->setOptions( 'hide_HeadLine', 1 );
337 $t->setCols('Class');
338 $t->setColWidth( 'Class', 75, 1 );
339 $t->addRow($_) for @plugins;
340 $class->log->debug( "Loaded plugins:\n" . $t->draw );
343 my $dispatcher = $class->dispatcher;
344 my $engine = $class->engine;
345 my $home = $class->config->{home};
347 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
348 $class->log->debug(qq/Loaded engine "$engine"/);
352 ? $class->log->debug(qq/Found home "$home"/)
353 : $class->log->debug(qq/Home "$home" doesn't exist/)
354 : $class->log->debug(q/Couldn't find home/);
359 no warnings qw/redefine/;
360 local *setup = sub { };
364 # Initialize our data structure
365 $class->components( {} );
367 $class->setup_components;
369 if ( $class->debug ) {
370 my $t = Text::ASCIITable->new;
371 $t->setOptions( 'hide_HeadRow', 1 );
372 $t->setOptions( 'hide_HeadLine', 1 );
373 $t->setCols('Class');
374 $t->setColWidth( 'Class', 75, 1 );
375 $t->addRow($_) for sort keys %{ $class->components };
376 $class->log->debug( "Loaded components:\n" . $t->draw )
377 if ( @{ $t->{tbl_rows} } );
380 # Add our self to components, since we are also a component
381 $class->components->{$class} = $class;
383 $class->setup_actions;
385 if ( $class->debug ) {
386 my $name = $class->config->{name} || 'Application';
387 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
389 $class->log->_flush() if $class->log->can('_flush');
392 =item $c->uri_for($path)
394 Merges path with $c->request->base for absolute uri's and with
395 $c->request->match for relative uri's, then returns a normalized
401 my ( $c, $path ) = @_;
402 my $base = $c->request->base->clone;
403 my $basepath = $base->path;
404 $basepath =~ s/\/$//;
406 my $match = $c->request->match;
408 $match .= '/' if $match;
409 $match = '' if $path =~ /^\//;
411 return URI->new_abs( URI->new_abs( $path, "$basepath$match" ), $base )
417 =item $c->error($error, ...)
419 =item $c->error($arrayref)
421 Returns an arrayref containing error messages.
423 my @error = @{ $c->error };
427 $c->error('Something bad happened');
433 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
434 push @{ $c->{error} }, @$error;
440 Contains the engine instance.
441 Stringifies to the class.
445 Contains the logging object. Unless it is already set Catalyst sets this up with a
446 C<Catalyst::Log> object. To use your own log class:
448 $c->log( MyLogger->new );
449 $c->log->info("now logging with my own logger!");
451 Your log class should implement the methods described in the C<Catalyst::Log>
454 =item $c->plugin( $name, $class, @args )
456 Instant plugins for Catalyst.
457 Classdata accessor/mutator will be created, class loaded and instantiated.
459 MyApp->plugin( 'prototype', 'HTML::Prototype' );
461 $c->prototype->define_javascript_functions;
466 my ( $class, $name, $plugin, @args ) = @_;
469 if ( my $error = $UNIVERSAL::require::ERROR ) {
470 Catalyst::Exception->throw(
471 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
474 eval { $plugin->import };
475 $class->mk_classdata($name);
477 eval { $obj = $plugin->new(@args) };
480 Catalyst::Exception->throw( message =>
481 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
485 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
493 Returns a C<Catalyst::Request> object.
501 Returns a C<Catalyst::Response> object.
507 Contains the return value of the last executed action.
511 Returns a hashref containing all your data.
513 print $c->stash->{foo};
515 Keys may be set in the stash by assigning to the hash reference, or by passing
516 either a single hash reference or a list of key/value pairs as arguments.
520 $c->stash->{foo} ||= 'yada';
521 $c->stash( { moose => 'majestic', qux => 0 } );
522 $c->stash( bar => 1, gorch => 2 );
529 my $stash = @_ > 1 ? {@_} : $_[0];
530 while ( my ( $key, $val ) = each %$stash ) {
531 $c->{stash}->{$key} = $val;
537 =item $c->welcome_message
539 Returns the Catalyst welcome HTML page.
543 sub welcome_message {
545 my $name = $c->config->{name};
546 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
547 my $prefix = Catalyst::Utils::appprefix( ref $c );
551 <title>$name on Catalyst $VERSION</title>
552 <style type="text/css">
557 background-color: #eee;
565 background-color: #ccc;
566 border: 1px solid #aaa;
567 -moz-border-radius: 10px;
572 font-family: verdana, tahoma, sans-serif;
575 font-family: verdana, tahoma, sans-serif;
578 text-decoration: none;
580 border-bottom: 1px dotted #bbb;
582 :link:hover, :visited:hover {
595 background-color: #fff;
596 border: 1px solid #aaa;
597 -moz-border-radius: 10px;
622 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
629 <p>Welcome to the wonderful world of Catalyst.
630 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
631 framework will make web development something you had
632 never expected it to be: Fun, rewarding and quick.</p>
633 <h2>What to do now?</h2>
634 <p>That really depends on what <b>you</b> want to do.
635 We do, however, provide you with a few starting points.</p>
636 <p>If you want to jump right into web development with Catalyst
637 you might want to check out the documentation.</p>
638 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
639 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
640 <h2>What to do next?</h2>
641 <p>Next it's time to write an actual application. Use the
642 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
643 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
644 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
645 they can save you a lot of work.</p>
646 <pre><code>script/${prefix}_create.pl -help</code></pre>
647 <p>Also, be sure to check out the vast and growing
648 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
649 you are likely to find what you need there.
653 <p>Catalyst has a very active community. Here are the main places to
654 get in touch with us.</p>
657 <a href="http://dev.catalyst.perl.org">Wiki</a>
660 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
663 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
666 <h2>In conclusion</h2>
667 <p>The Catalyst team hope you will enjoy using Catalyst as much
668 as we enjoyed making it. Please contact us if you have ideas
669 for improvement or other feedback.</p>
679 =head1 INTERNAL METHODS
683 =item $c->benchmark($coderef)
685 Takes a coderef with arguments and returns elapsed time as float.
687 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
688 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
695 my $time = [gettimeofday];
696 my @return = &$code(@_);
697 my $elapsed = tv_interval $time;
698 return wantarray ? ( $elapsed, @return ) : $elapsed;
703 Contains the components.
707 Returns a hashref containing coderefs and execution counts.
708 (Needed for deep recursion detection)
712 Returns the actual forward depth.
716 Dispatch request to actions.
720 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
722 =item $c->execute($class, $coderef)
724 Execute a coderef in given class and catch exceptions.
725 Errors are available via $c->error.
730 my ( $c, $class, $code ) = @_;
731 $class = $c->components->{$class} || $class;
733 my $callsub = ( caller(1) )[3];
738 $action = "/$action" unless $action =~ /\-\>/;
739 $c->counter->{"$code"}++;
741 if ( $c->counter->{"$code"} > $RECURSION ) {
742 my $error = qq/Deep recursion detected in "$action"/;
743 $c->log->error($error);
749 $action = "-> $action" if $callsub =~ /forward$/;
754 my ( $elapsed, @state ) =
755 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
756 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
760 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 )
765 if ( my $error = $@ ) {
767 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
769 unless ( ref $error ) {
771 $error = qq/Caught exception "$error"/;
774 $c->log->error($error);
791 $c->finalize_uploads;
794 if ( $#{ $c->error } >= 0 ) {
798 $c->finalize_headers;
801 if ( $c->request->method eq 'HEAD' ) {
802 $c->response->body('');
807 return $c->response->status;
810 =item $c->finalize_body
816 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
818 =item $c->finalize_cookies
824 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
826 =item $c->finalize_error
832 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
834 =item $c->finalize_headers
840 sub finalize_headers {
843 # Check if we already finalized headers
844 return if $c->response->{_finalized_headers};
847 if ( my $location = $c->response->redirect ) {
848 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
849 $c->response->header( Location => $location );
853 if ( $c->response->body && !$c->response->content_length ) {
854 $c->response->content_length( bytes::length( $c->response->body ) );
858 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
859 $c->response->headers->remove_header("Content-Length");
860 $c->response->body('');
863 $c->finalize_cookies;
865 $c->engine->finalize_headers( $c, @_ );
868 $c->response->{_finalized_headers} = 1;
871 =item $c->finalize_output
873 An alias for finalize_body.
875 =item $c->finalize_read
877 Finalize the input after reading is complete.
881 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
883 =item $c->finalize_uploads
885 Finalize uploads. Cleans up any temporary files.
889 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
891 =item $c->get_action( $action, $namespace, $inherit )
893 Get an action in a given namespace.
897 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
899 =item handle_request( $class, @arguments )
906 my ( $class, @arguments ) = @_;
908 # Always expect worst case!
914 my $c = $class->prepare(@arguments);
915 $c->{stats} = \@stats;
920 if ( $class->debug ) {
922 ( $elapsed, $status ) = $class->benchmark($handler);
923 $elapsed = sprintf '%f', $elapsed;
924 my $av = sprintf '%.3f',
925 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
926 my $t = Text::ASCIITable->new;
927 $t->setCols( 'Action', 'Time' );
928 $t->setColWidth( 'Action', 64, 1 );
929 $t->setColWidth( 'Time', 9, 1 );
931 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
933 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
935 else { $status = &$handler }
939 if ( my $error = $@ ) {
941 $class->log->error(qq/Caught exception in engine "$error"/);
945 $class->log->_flush() if $class->log->can('_flush');
949 =item $c->prepare(@arguments)
951 Turns the engine-specific request( Apache, CGI ... )
952 into a Catalyst context .
957 my ( $class, @arguments ) = @_;
962 request => Catalyst::Request->new(
965 body_parameters => {},
967 headers => HTTP::Headers->new,
969 query_parameters => {},
975 response => Catalyst::Response->new(
979 headers => HTTP::Headers->new(),
988 $c->request->{_context} = $c;
989 $c->response->{_context} = $c;
990 weaken( $c->request->{_context} );
991 weaken( $c->response->{_context} );
994 my $secs = time - $START || 1;
995 my $av = sprintf '%.3f', $COUNT / $secs;
996 $c->log->debug('**********************************');
997 $c->log->debug("* Request $COUNT ($av/s) [$$]");
998 $c->log->debug('**********************************');
999 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1002 $c->prepare_request(@arguments);
1003 $c->prepare_connection;
1004 $c->prepare_query_parameters;
1005 $c->prepare_headers;
1006 $c->prepare_cookies;
1010 $c->prepare_body unless $c->config->{parse_on_demand};
1013 my $method = $c->req->method || '';
1014 my $path = $c->req->path || '';
1015 my $address = $c->req->address || '';
1017 $c->log->debug(qq/"$method" request for "$path" from $address/)
1023 =item $c->prepare_action
1029 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1031 =item $c->prepare_body
1033 Prepare message body.
1040 # Do we run for the first time?
1041 return if defined $c->request->{_body};
1043 # Initialize on-demand data
1044 $c->engine->prepare_body( $c, @_ );
1045 $c->prepare_parameters;
1046 $c->prepare_uploads;
1048 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1049 my $t = Text::ASCIITable->new;
1050 $t->setCols( 'Key', 'Value' );
1051 $t->setColWidth( 'Key', 37, 1 );
1052 $t->setColWidth( 'Value', 36, 1 );
1053 $t->alignCol( 'Value', 'right' );
1054 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1055 my $param = $c->req->body_parameters->{$key};
1056 my $value = defined($param) ? $param : '';
1058 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1060 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1064 =item $c->prepare_body_chunk( $chunk )
1066 Prepare a chunk of data before sending it to HTTP::Body.
1070 sub prepare_body_chunk {
1072 $c->engine->prepare_body_chunk( $c, @_ );
1075 =item $c->prepare_body_parameters
1077 Prepare body parameters.
1081 sub prepare_body_parameters {
1083 $c->engine->prepare_body_parameters( $c, @_ );
1086 =item $c->prepare_connection
1092 sub prepare_connection {
1094 $c->engine->prepare_connection( $c, @_ );
1097 =item $c->prepare_cookies
1103 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1105 =item $c->prepare_headers
1111 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1113 =item $c->prepare_parameters
1119 sub prepare_parameters {
1121 $c->prepare_body_parameters;
1122 $c->engine->prepare_parameters( $c, @_ );
1125 =item $c->prepare_path
1127 Prepare path and base.
1131 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1133 =item $c->prepare_query_parameters
1135 Prepare query parameters.
1139 sub prepare_query_parameters {
1142 $c->engine->prepare_query_parameters( $c, @_ );
1144 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1145 my $t = Text::ASCIITable->new;
1146 $t->setCols( 'Key', 'Value' );
1147 $t->setColWidth( 'Key', 37, 1 );
1148 $t->setColWidth( 'Value', 36, 1 );
1149 $t->alignCol( 'Value', 'right' );
1150 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1151 my $param = $c->req->query_parameters->{$key};
1152 my $value = defined($param) ? $param : '';
1154 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1156 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1160 =item $c->prepare_read
1162 Prepare the input for reading.
1166 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1168 =item $c->prepare_request
1170 Prepare the engine request.
1174 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1176 =item $c->prepare_uploads
1182 sub prepare_uploads {
1185 $c->engine->prepare_uploads( $c, @_ );
1187 if ( $c->debug && keys %{ $c->request->uploads } ) {
1188 my $t = Text::ASCIITable->new;
1189 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1190 $t->setColWidth( 'Key', 12, 1 );
1191 $t->setColWidth( 'Filename', 28, 1 );
1192 $t->setColWidth( 'Type', 18, 1 );
1193 $t->setColWidth( 'Size', 9, 1 );
1194 $t->alignCol( 'Size', 'left' );
1195 for my $key ( sort keys %{ $c->request->uploads } ) {
1196 my $upload = $c->request->uploads->{$key};
1197 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1198 $t->addRow( $key, $u->filename, $u->type, $u->size );
1201 $c->log->debug( "File Uploads are:\n" . $t->draw );
1205 =item $c->prepare_write
1207 Prepare the output for writing.
1211 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1213 =item $c->read( [$maxlength] )
1215 Read a chunk of data from the request body. This method is designed to be
1216 used in a while loop, reading $maxlength bytes on every call. $maxlength
1217 defaults to the size of the request if not specified.
1219 You have to set MyApp->config->{parse_on_demand} to use this directly.
1223 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1231 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1233 =item $c->set_action( $action, $code, $namespace, $attrs )
1235 Set an action in a given namespace.
1239 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1241 =item $c->setup_actions($component)
1243 Setup actions for a component.
1247 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1249 =item $c->setup_components
1255 sub setup_components {
1258 my $callback = sub {
1259 my ( $component, $context ) = @_;
1261 unless ( $component->isa('Catalyst::Base') ) {
1265 my $suffix = Catalyst::Utils::class2classsuffix($component);
1266 my $config = $class->config->{$suffix} || {};
1270 eval { $instance = $component->new( $context, $config ); };
1272 if ( my $error = $@ ) {
1276 Catalyst::Exception->throw( message =>
1277 qq/Couldn't instantiate component "$component", "$error"/ );
1280 Catalyst::Exception->throw( message =>
1281 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1283 unless ref $instance;
1288 Module::Pluggable::Fast->import(
1289 name => '_catalyst_components',
1291 "$class\::Controller", "$class\::C",
1292 "$class\::Model", "$class\::M",
1293 "$class\::View", "$class\::V"
1295 callback => $callback
1299 if ( my $error = $@ ) {
1303 Catalyst::Exception->throw(
1304 message => qq/Couldn't load components "$error"/ );
1307 for my $component ( $class->_catalyst_components($class) ) {
1308 $class->components->{ ref $component || $component } = $component;
1312 =item $c->setup_dispatcher
1316 sub setup_dispatcher {
1317 my ( $class, $dispatcher ) = @_;
1320 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1323 if ( $ENV{CATALYST_DISPATCHER} ) {
1324 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1327 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1329 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1332 unless ($dispatcher) {
1333 $dispatcher = 'Catalyst::Dispatcher';
1336 $dispatcher->require;
1339 Catalyst::Exception->throw(
1340 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1343 # dispatcher instance
1344 $class->dispatcher( $dispatcher->new );
1347 =item $c->setup_engine
1352 my ( $class, $engine ) = @_;
1355 $engine = 'Catalyst::Engine::' . $engine;
1358 if ( $ENV{CATALYST_ENGINE} ) {
1359 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1362 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1363 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1366 if ( !$engine && $ENV{MOD_PERL} ) {
1368 # create the apache method
1371 *{"$class\::apache"} = sub { shift->engine->apache };
1374 my ( $software, $version ) =
1375 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1378 $version =~ s/(\.[^.]+)\./$1/g;
1380 if ( $software eq 'mod_perl' ) {
1382 if ( $version >= 1.99922 ) {
1383 $engine = 'Catalyst::Engine::Apache2::MP20';
1386 elsif ( $version >= 1.9901 ) {
1387 $engine = 'Catalyst::Engine::Apache2::MP19';
1390 elsif ( $version >= 1.24 ) {
1391 $engine = 'Catalyst::Engine::Apache::MP13';
1395 Catalyst::Exception->throw( message =>
1396 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1399 # install the correct mod_perl handler
1400 if ( $version >= 1.9901 ) {
1401 *handler = sub : method {
1402 shift->handle_request(@_);
1406 *handler = sub ($$) { shift->handle_request(@_) };
1411 elsif ( $software eq 'Zeus-Perl' ) {
1412 $engine = 'Catalyst::Engine::Zeus';
1416 Catalyst::Exception->throw(
1417 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1422 $engine = 'Catalyst::Engine::CGI';
1428 Catalyst::Exception->throw( message =>
1429 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1434 $class->engine( $engine->new );
1437 =item $c->setup_home
1442 my ( $class, $home ) = @_;
1444 if ( $ENV{CATALYST_HOME} ) {
1445 $home = $ENV{CATALYST_HOME};
1448 if ( $ENV{ uc($class) . '_HOME' } ) {
1449 $home = $ENV{ uc($class) . '_HOME' };
1453 $home = Catalyst::Utils::home($class);
1457 $class->config->{home} ||= $home;
1458 $class->config->{root} ||= dir($home)->subdir('root');
1467 my ( $class, $debug ) = @_;
1469 unless ( $class->log ) {
1470 $class->log( Catalyst::Log->new );
1473 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1475 *{"$class\::debug"} = sub { 1 };
1476 $class->log->debug('Debug messages enabled');
1480 =item $c->setup_plugins
1485 my ( $class, $plugins ) = @_;
1488 for my $plugin ( reverse @$plugins ) {
1490 $plugin = "Catalyst::Plugin::$plugin";
1495 Catalyst::Exception->throw(
1496 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1501 unshift @{"$class\::ISA"}, $plugin;
1506 =item $c->write( $data )
1508 Writes $data to the output stream. When using this method directly, you will
1509 need to manually set the Content-Length header to the length of your output
1517 # Finalize headers if someone manually writes output
1518 $c->finalize_headers;
1520 return $c->engine->write( $c, @_ );
1525 =head1 CASE SENSITIVITY
1527 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1530 But you can activate case sensitivity with a config parameter.
1532 MyApp->config->{case_sensitive} = 1;
1534 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1536 =head1 ON-DEMAND PARSER
1538 The request body is usually parsed at the beginning of a request,
1539 but if you want to handle input yourself or speed things up a bit
1540 you can enable on-demand parsing with a config parameter.
1542 MyApp->config->{parse_on_demand} = 1;
1544 =head1 PROXY SUPPORT
1546 Many production servers operate using the common double-server approach, with
1547 a lightweight frontend web server passing requests to a larger backend
1548 server. An application running on the backend server must deal with two
1549 problems: the remote user always appears to be '127.0.0.1' and the server's
1550 hostname will appear to be 'localhost' regardless of the virtual host the
1551 user connected through.
1553 Catalyst will automatically detect this situation when you are running both
1554 the frontend and backend servers on the same machine. The following changes
1555 are made to the request.
1557 $c->req->address is set to the user's real IP address, as read from the
1558 HTTP_X_FORWARDED_FOR header.
1560 The host value for $c->req->base and $c->req->uri is set to the real host,
1561 as read from the HTTP_X_FORWARDED_HOST header.
1563 Obviously, your web server must support these 2 headers for this to work.
1565 In a more complex server farm environment where you may have your frontend
1566 proxy server(s) on different machines, you will need to set a configuration
1567 option to tell Catalyst to read the proxied data from the headers.
1569 MyApp->config->{using_frontend_proxy} = 1;
1571 If you do not wish to use the proxy support at all, you may set:
1573 MyApp->config->{ignore_frontend_proxy} = 1;
1575 =head1 THREAD SAFETY
1577 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1578 and the standalone forking HTTP server on Windows. We believe the Catalyst
1579 core to be thread-safe.
1581 If you plan to operate in a threaded environment, remember that all other
1582 modules you are using must also be thread-safe. Some modules, most notably
1583 DBD::SQLite, are not thread-safe.
1589 Join #catalyst on irc.perl.org.
1593 http://lists.rawmode.org/mailman/listinfo/catalyst
1594 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1598 http://catalyst.perl.org
1604 =item L<Catalyst::Manual> - The Catalyst Manual
1606 =item L<Catalyst::Engine> - Core Engine
1608 =item L<Catalyst::Log> - The Log Class.
1610 =item L<Catalyst::Request> - The Request Object
1612 =item L<Catalyst::Response> - The Response Object
1614 =item L<Catalyst::Test> - The test suite.
1676 Sebastian Riedel, C<sri@oook.de>
1680 This library is free software . You can redistribute it and/or modify it under
1681 the same terms as Perl itself.