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$/;
755 my ( $elapsed, @state ) =
756 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
757 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
760 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
764 if ( my $error = $@ ) {
766 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
768 unless ( ref $error ) {
770 $error = qq/Caught exception "$error"/;
773 $c->log->error($error);
790 $c->finalize_uploads;
793 if ( $#{ $c->error } >= 0 ) {
797 $c->finalize_headers;
800 if ( $c->request->method eq 'HEAD' ) {
801 $c->response->body('');
806 return $c->response->status;
809 =item $c->finalize_body
815 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
817 =item $c->finalize_cookies
823 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
825 =item $c->finalize_error
831 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
833 =item $c->finalize_headers
839 sub finalize_headers {
842 # Check if we already finalized headers
843 return if $c->response->{_finalized_headers};
846 if ( my $location = $c->response->redirect ) {
847 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
848 $c->response->header( Location => $location );
852 if ( $c->response->body && !$c->response->content_length ) {
853 $c->response->content_length( bytes::length( $c->response->body ) );
857 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
858 $c->response->headers->remove_header("Content-Length");
859 $c->response->body('');
862 $c->finalize_cookies;
864 $c->engine->finalize_headers( $c, @_ );
867 $c->response->{_finalized_headers} = 1;
870 =item $c->finalize_output
872 An alias for finalize_body.
874 =item $c->finalize_read
876 Finalize the input after reading is complete.
880 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
882 =item $c->finalize_uploads
884 Finalize uploads. Cleans up any temporary files.
888 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
890 =item $c->get_action( $action, $namespace, $inherit )
892 Get an action in a given namespace.
896 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
898 =item handle_request( $class, @arguments )
905 my ( $class, @arguments ) = @_;
907 # Always expect worst case!
913 my $c = $class->prepare(@arguments);
914 $c->{stats} = \@stats;
919 if ( $class->debug ) {
921 ( $elapsed, $status ) = $class->benchmark($handler);
922 $elapsed = sprintf '%f', $elapsed;
923 my $av = sprintf '%.3f',
924 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
925 my $t = Text::ASCIITable->new;
926 $t->setCols( 'Action', 'Time' );
927 $t->setColWidth( 'Action', 64, 1 );
928 $t->setColWidth( 'Time', 9, 1 );
930 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
932 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
934 else { $status = &$handler }
938 if ( my $error = $@ ) {
940 $class->log->error(qq/Caught exception in engine "$error"/);
944 $class->log->_flush() if $class->log->can('_flush');
948 =item $c->prepare(@arguments)
950 Turns the engine-specific request( Apache, CGI ... )
951 into a Catalyst context .
956 my ( $class, @arguments ) = @_;
961 request => Catalyst::Request->new(
964 body_parameters => {},
966 headers => HTTP::Headers->new,
968 query_parameters => {},
974 response => Catalyst::Response->new(
978 headers => HTTP::Headers->new(),
987 $c->request->{_context} = $c;
988 $c->response->{_context} = $c;
989 weaken( $c->request->{_context} );
990 weaken( $c->response->{_context} );
993 my $secs = time - $START || 1;
994 my $av = sprintf '%.3f', $COUNT / $secs;
995 $c->log->debug('**********************************');
996 $c->log->debug("* Request $COUNT ($av/s) [$$]");
997 $c->log->debug('**********************************');
998 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1001 $c->prepare_request(@arguments);
1002 $c->prepare_connection;
1003 $c->prepare_query_parameters;
1004 $c->prepare_headers;
1005 $c->prepare_cookies;
1009 $c->prepare_body unless $c->config->{parse_on_demand};
1012 my $method = $c->req->method || '';
1013 my $path = $c->req->path || '';
1014 my $address = $c->req->address || '';
1016 $c->log->debug(qq/"$method" request for "$path" from $address/)
1022 =item $c->prepare_action
1028 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1030 =item $c->prepare_body
1032 Prepare message body.
1039 # Do we run for the first time?
1040 return if defined $c->request->{_body};
1042 # Initialize on-demand data
1043 $c->engine->prepare_body( $c, @_ );
1044 $c->prepare_parameters;
1045 $c->prepare_uploads;
1047 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1048 my $t = Text::ASCIITable->new;
1049 $t->setCols( 'Key', 'Value' );
1050 $t->setColWidth( 'Key', 37, 1 );
1051 $t->setColWidth( 'Value', 36, 1 );
1052 $t->alignCol( 'Value', 'right' );
1053 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1054 my $param = $c->req->body_parameters->{$key};
1055 my $value = defined($param) ? $param : '';
1057 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1059 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1063 =item $c->prepare_body_chunk( $chunk )
1065 Prepare a chunk of data before sending it to HTTP::Body.
1069 sub prepare_body_chunk {
1071 $c->engine->prepare_body_chunk( $c, @_ );
1074 =item $c->prepare_body_parameters
1076 Prepare body parameters.
1080 sub prepare_body_parameters {
1082 $c->engine->prepare_body_parameters( $c, @_ );
1085 =item $c->prepare_connection
1091 sub prepare_connection {
1093 $c->engine->prepare_connection( $c, @_ );
1096 =item $c->prepare_cookies
1102 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1104 =item $c->prepare_headers
1110 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1112 =item $c->prepare_parameters
1118 sub prepare_parameters {
1120 $c->prepare_body_parameters;
1121 $c->engine->prepare_parameters( $c, @_ );
1124 =item $c->prepare_path
1126 Prepare path and base.
1130 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1132 =item $c->prepare_query_parameters
1134 Prepare query parameters.
1138 sub prepare_query_parameters {
1141 $c->engine->prepare_query_parameters( $c, @_ );
1143 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1144 my $t = Text::ASCIITable->new;
1145 $t->setCols( 'Key', 'Value' );
1146 $t->setColWidth( 'Key', 37, 1 );
1147 $t->setColWidth( 'Value', 36, 1 );
1148 $t->alignCol( 'Value', 'right' );
1149 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1150 my $param = $c->req->query_parameters->{$key};
1151 my $value = defined($param) ? $param : '';
1153 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1155 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1159 =item $c->prepare_read
1161 Prepare the input for reading.
1165 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1167 =item $c->prepare_request
1169 Prepare the engine request.
1173 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1175 =item $c->prepare_uploads
1181 sub prepare_uploads {
1184 $c->engine->prepare_uploads( $c, @_ );
1186 if ( $c->debug && keys %{ $c->request->uploads } ) {
1187 my $t = Text::ASCIITable->new;
1188 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1189 $t->setColWidth( 'Key', 12, 1 );
1190 $t->setColWidth( 'Filename', 28, 1 );
1191 $t->setColWidth( 'Type', 18, 1 );
1192 $t->setColWidth( 'Size', 9, 1 );
1193 $t->alignCol( 'Size', 'left' );
1194 for my $key ( sort keys %{ $c->request->uploads } ) {
1195 my $upload = $c->request->uploads->{$key};
1196 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1197 $t->addRow( $key, $u->filename, $u->type, $u->size );
1200 $c->log->debug( "File Uploads are:\n" . $t->draw );
1204 =item $c->prepare_write
1206 Prepare the output for writing.
1210 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1212 =item $c->read( [$maxlength] )
1214 Read a chunk of data from the request body. This method is designed to be
1215 used in a while loop, reading $maxlength bytes on every call. $maxlength
1216 defaults to the size of the request if not specified.
1218 You have to set MyApp->config->{parse_on_demand} to use this directly.
1222 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1230 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1232 =item $c->set_action( $action, $code, $namespace, $attrs )
1234 Set an action in a given namespace.
1238 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1240 =item $c->setup_actions($component)
1242 Setup actions for a component.
1246 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1248 =item $c->setup_components
1254 sub setup_components {
1257 my $callback = sub {
1258 my ( $component, $context ) = @_;
1260 unless ( $component->isa('Catalyst::Base') ) {
1264 my $suffix = Catalyst::Utils::class2classsuffix($component);
1265 my $config = $class->config->{$suffix} || {};
1269 eval { $instance = $component->new( $context, $config ); };
1271 if ( my $error = $@ ) {
1275 Catalyst::Exception->throw( message =>
1276 qq/Couldn't instantiate component "$component", "$error"/ );
1279 Catalyst::Exception->throw( message =>
1280 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1282 unless ref $instance;
1287 Module::Pluggable::Fast->import(
1288 name => '_catalyst_components',
1290 "$class\::Controller", "$class\::C",
1291 "$class\::Model", "$class\::M",
1292 "$class\::View", "$class\::V"
1294 callback => $callback
1298 if ( my $error = $@ ) {
1302 Catalyst::Exception->throw(
1303 message => qq/Couldn't load components "$error"/ );
1306 for my $component ( $class->_catalyst_components($class) ) {
1307 $class->components->{ ref $component || $component } = $component;
1311 =item $c->setup_dispatcher
1315 sub setup_dispatcher {
1316 my ( $class, $dispatcher ) = @_;
1319 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1322 if ( $ENV{CATALYST_DISPATCHER} ) {
1323 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1326 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1328 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1331 unless ($dispatcher) {
1332 $dispatcher = 'Catalyst::Dispatcher';
1335 $dispatcher->require;
1338 Catalyst::Exception->throw(
1339 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1342 # dispatcher instance
1343 $class->dispatcher( $dispatcher->new );
1346 =item $c->setup_engine
1351 my ( $class, $engine ) = @_;
1354 $engine = 'Catalyst::Engine::' . $engine;
1357 if ( $ENV{CATALYST_ENGINE} ) {
1358 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1361 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1362 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1365 if ( !$engine && $ENV{MOD_PERL} ) {
1367 # create the apache method
1370 *{"$class\::apache"} = sub { shift->engine->apache };
1373 my ( $software, $version ) =
1374 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1377 $version =~ s/(\.[^.]+)\./$1/g;
1379 if ( $software eq 'mod_perl' ) {
1381 if ( $version >= 1.99922 ) {
1382 $engine = 'Catalyst::Engine::Apache2::MP20';
1385 elsif ( $version >= 1.9901 ) {
1386 $engine = 'Catalyst::Engine::Apache2::MP19';
1389 elsif ( $version >= 1.24 ) {
1390 $engine = 'Catalyst::Engine::Apache::MP13';
1394 Catalyst::Exception->throw( message =>
1395 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1398 # install the correct mod_perl handler
1399 if ( $version >= 1.9901 ) {
1400 *handler = sub : method {
1401 shift->handle_request(@_);
1405 *handler = sub ($$) { shift->handle_request(@_) };
1410 elsif ( $software eq 'Zeus-Perl' ) {
1411 $engine = 'Catalyst::Engine::Zeus';
1415 Catalyst::Exception->throw(
1416 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1421 $engine = 'Catalyst::Engine::CGI';
1427 Catalyst::Exception->throw( message =>
1428 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1433 $class->engine( $engine->new );
1436 =item $c->setup_home
1441 my ( $class, $home ) = @_;
1443 if ( $ENV{CATALYST_HOME} ) {
1444 $home = $ENV{CATALYST_HOME};
1447 if ( $ENV{ uc($class) . '_HOME' } ) {
1448 $home = $ENV{ uc($class) . '_HOME' };
1452 $home = Catalyst::Utils::home($class);
1456 $class->config->{home} ||= $home;
1457 $class->config->{root} ||= dir($home)->subdir('root');
1466 my ( $class, $debug ) = @_;
1468 unless ( $class->log ) {
1469 $class->log( Catalyst::Log->new );
1472 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1474 *{"$class\::debug"} = sub { 1 };
1475 $class->log->debug('Debug messages enabled');
1479 =item $c->setup_plugins
1484 my ( $class, $plugins ) = @_;
1487 for my $plugin ( reverse @$plugins ) {
1489 $plugin = "Catalyst::Plugin::$plugin";
1494 Catalyst::Exception->throw(
1495 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1500 unshift @{"$class\::ISA"}, $plugin;
1505 =item $c->write( $data )
1507 Writes $data to the output stream. When using this method directly, you will
1508 need to manually set the Content-Length header to the length of your output
1516 # Finalize headers if someone manually writes output
1517 $c->finalize_headers;
1519 return $c->engine->write( $c, @_ );
1524 =head1 CASE SENSITIVITY
1526 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1529 But you can activate case sensitivity with a config parameter.
1531 MyApp->config->{case_sensitive} = 1;
1533 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1535 =head1 ON-DEMAND PARSER
1537 The request body is usually parsed at the beginning of a request,
1538 but if you want to handle input yourself or speed things up a bit
1539 you can enable on-demand parsing with a config parameter.
1541 MyApp->config->{parse_on_demand} = 1;
1543 =head1 PROXY SUPPORT
1545 Many production servers operate using the common double-server approach, with
1546 a lightweight frontend web server passing requests to a larger backend
1547 server. An application running on the backend server must deal with two
1548 problems: the remote user always appears to be '127.0.0.1' and the server's
1549 hostname will appear to be 'localhost' regardless of the virtual host the
1550 user connected through.
1552 Catalyst will automatically detect this situation when you are running both
1553 the frontend and backend servers on the same machine. The following changes
1554 are made to the request.
1556 $c->req->address is set to the user's real IP address, as read from the
1557 HTTP_X_FORWARDED_FOR header.
1559 The host value for $c->req->base and $c->req->uri is set to the real host,
1560 as read from the HTTP_X_FORWARDED_HOST header.
1562 Obviously, your web server must support these 2 headers for this to work.
1564 In a more complex server farm environment where you may have your frontend
1565 proxy server(s) on different machines, you will need to set a configuration
1566 option to tell Catalyst to read the proxied data from the headers.
1568 MyApp->config->{using_frontend_proxy} = 1;
1570 If you do not wish to use the proxy support at all, you may set:
1572 MyApp->config->{ignore_frontend_proxy} = 1;
1574 =head1 THREAD SAFETY
1576 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1577 and the standalone forking HTTP server on Windows. We believe the Catalyst
1578 core to be thread-safe.
1580 If you plan to operate in a threaded environment, remember that all other
1581 modules you are using must also be thread-safe. Some modules, most notably
1582 DBD::SQLite, are not thread-safe.
1588 Join #catalyst on irc.perl.org.
1592 http://lists.rawmode.org/mailman/listinfo/catalyst
1593 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1597 http://catalyst.perl.org
1603 =item L<Catalyst::Manual> - The Catalyst Manual
1605 =item L<Catalyst::Engine> - Core Engine
1607 =item L<Catalyst::Log> - The Log Class.
1609 =item L<Catalyst::Request> - The Request Object
1611 =item L<Catalyst::Response> - The Response Object
1613 =item L<Catalyst::Test> - The test suite.
1675 Sebastian Riedel, C<sri@oook.de>
1679 This library is free software . You can redistribute it and/or modify it under
1680 the same terms as Perl itself.