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 print $c->stash->{foo};
505 Keys may be set in the stash by assigning to the hash reference, or by passing
506 either a single hash reference or a list of key/value pairs as arguments.
510 $c->stash->{foo} ||= 'yada';
511 $c->stash( { moose => 'majestic', qux => 0 } );
512 $c->stash( bar => 1, gorch => 2 );
519 my $stash = @_ > 1 ? {@_} : $_[0];
520 while ( my ( $key, $val ) = each %$stash ) {
521 $c->{stash}->{$key} = $val;
527 =item $c->welcome_message
529 Returns the Catalyst welcome HTML page.
533 sub welcome_message {
535 my $name = $c->config->{name};
536 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
537 my $prefix = Catalyst::Utils::appprefix( ref $c );
541 <title>$name on Catalyst $VERSION</title>
542 <style type="text/css">
547 background-color: #eee;
555 background-color: #ccc;
556 border: 1px solid #aaa;
557 -moz-border-radius: 10px;
562 font-family: verdana, tahoma, sans-serif;
565 font-family: verdana, tahoma, sans-serif;
568 text-decoration: none;
570 border-bottom: 1px dotted #bbb;
572 :link:hover, :visited:hover {
585 background-color: #fff;
586 border: 1px solid #aaa;
587 -moz-border-radius: 10px;
612 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
619 <p>Welcome to the wonderful world of Catalyst.
620 This MVC framework will make web development
621 something you had never expected it to be:
622 Fun, rewarding and quick.</p>
623 <h2>What to do now?</h2>
624 <p>That really depends on what <b>you</b> want to do.
625 We do, however, provide you with a few starting points.</p>
626 <p>If you want to jump right into web development with Catalyst
627 you might want to check out the documentation.</p>
628 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
629 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
630 <h2>What to do next?</h2>
631 <p>Next it's time to write an actual application. Use the
632 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
633 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
634 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
635 they can save you a lot of work.</p>
636 <pre><code>script/${prefix}_create.pl -help</code></pre>
637 <p>Also, be sure to check out the vast and growing
638 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
639 you are likely to find what you need there.
643 <p>Catalyst has a very active community. Here are the main places to
644 get in touch with us.</p>
647 <a href="http://dev.catalyst.perl.org">Wiki</a>
650 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
653 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
656 <h2>In conclusion</h2>
657 <p>The Catalyst team hope you will enjoy using Catalyst as much
658 as we enjoyed making it. Please contact us if you have ideas
659 for improvement or other feedback.</p>
669 =head1 INTERNAL METHODS
673 =item $c->benchmark($coderef)
675 Takes a coderef with arguments and returns elapsed time as float.
677 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
678 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
685 my $time = [gettimeofday];
686 my @return = &$code(@_);
687 my $elapsed = tv_interval $time;
688 return wantarray ? ( $elapsed, @return ) : $elapsed;
693 Contains the components.
697 Returns a hashref containing coderefs and execution counts.
698 (Needed for deep recursion detection)
702 Returns the actual forward depth.
706 Dispatch request to actions.
710 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
712 =item $c->execute($class, $coderef)
714 Execute a coderef in given class and catch exceptions.
715 Errors are available via $c->error.
720 my ( $c, $class, $code ) = @_;
721 $class = $c->components->{$class} || $class;
723 my $callsub = ( caller(1) )[3];
728 $action = "/$action" unless $action =~ /\-\>/;
729 $c->counter->{"$code"}++;
731 if ( $c->counter->{"$code"} > $RECURSION ) {
732 my $error = qq/Deep recursion detected in "$action"/;
733 $c->log->error($error);
739 $action = "-> $action" if $callsub =~ /forward$/;
745 my ( $elapsed, @state ) =
746 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
747 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
750 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
754 if ( my $error = $@ ) {
756 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
758 unless ( ref $error ) {
760 $error = qq/Caught exception "$error"/;
763 $c->log->error($error);
780 $c->finalize_uploads;
783 if ( $#{ $c->error } >= 0 ) {
787 $c->finalize_headers;
790 if ( $c->request->method eq 'HEAD' ) {
791 $c->response->body('');
796 return $c->response->status;
799 =item $c->finalize_body
805 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
807 =item $c->finalize_cookies
813 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
815 =item $c->finalize_error
821 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
823 =item $c->finalize_headers
829 sub finalize_headers {
832 # Check if we already finalized headers
833 return if $c->response->{_finalized_headers};
836 if ( my $location = $c->response->redirect ) {
837 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
838 $c->response->header( Location => $location );
842 if ( $c->response->body && !$c->response->content_length ) {
843 $c->response->content_length( bytes::length( $c->response->body ) );
847 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
848 $c->response->headers->remove_header("Content-Length");
849 $c->response->body('');
852 $c->finalize_cookies;
854 $c->engine->finalize_headers( $c, @_ );
857 $c->response->{_finalized_headers} = 1;
860 =item $c->finalize_output
862 An alias for finalize_body.
864 =item $c->finalize_read
866 Finalize the input after reading is complete.
870 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
872 =item $c->finalize_uploads
874 Finalize uploads. Cleans up any temporary files.
878 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
880 =item $c->get_action( $action, $namespace, $inherit )
882 Get an action in a given namespace.
886 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
888 =item handle_request( $class, @arguments )
895 my ( $class, @arguments ) = @_;
897 # Always expect worst case!
903 my $c = $class->prepare(@arguments);
904 $c->{stats} = \@stats;
909 if ( $class->debug ) {
911 ( $elapsed, $status ) = $class->benchmark($handler);
912 $elapsed = sprintf '%f', $elapsed;
913 my $av = sprintf '%.3f',
914 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
915 my $t = Text::ASCIITable->new;
916 $t->setCols( 'Action', 'Time' );
917 $t->setColWidth( 'Action', 64, 1 );
918 $t->setColWidth( 'Time', 9, 1 );
920 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
922 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
924 else { $status = &$handler }
928 if ( my $error = $@ ) {
930 $class->log->error(qq/Caught exception in engine "$error"/);
934 $class->log->_flush() if $class->log->can('_flush');
938 =item $c->prepare(@arguments)
940 Turns the engine-specific request( Apache, CGI ... )
941 into a Catalyst context .
946 my ( $class, @arguments ) = @_;
951 request => Catalyst::Request->new(
954 body_parameters => {},
956 headers => HTTP::Headers->new,
958 query_parameters => {},
964 response => Catalyst::Response->new(
968 headers => HTTP::Headers->new(),
977 $c->request->{_context} = $c;
978 $c->response->{_context} = $c;
979 weaken( $c->request->{_context} );
980 weaken( $c->response->{_context} );
983 my $secs = time - $START || 1;
984 my $av = sprintf '%.3f', $COUNT / $secs;
985 $c->log->debug('**********************************');
986 $c->log->debug("* Request $COUNT ($av/s) [$$]");
987 $c->log->debug('**********************************');
988 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
991 $c->prepare_request(@arguments);
992 $c->prepare_connection;
993 $c->prepare_query_parameters;
999 $c->prepare_body unless $c->config->{parse_on_demand};
1002 my $method = $c->req->method || '';
1003 my $path = $c->req->path || '';
1004 my $address = $c->req->address || '';
1006 $c->log->debug(qq/"$method" request for "$path" from $address/)
1012 =item $c->prepare_action
1018 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1020 =item $c->prepare_body
1022 Prepare message body.
1029 # Do we run for the first time?
1030 return if defined $c->request->{_body};
1032 # Initialize on-demand data
1033 $c->engine->prepare_body( $c, @_ );
1034 $c->prepare_parameters;
1035 $c->prepare_uploads;
1037 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1038 my $t = Text::ASCIITable->new;
1039 $t->setCols( 'Key', 'Value' );
1040 $t->setColWidth( 'Key', 37, 1 );
1041 $t->setColWidth( 'Value', 36, 1 );
1042 $t->alignCol( 'Value', 'right' );
1043 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1044 my $param = $c->req->body_parameters->{$key};
1045 my $value = defined($param) ? $param : '';
1047 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1049 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1053 =item $c->prepare_body_chunk( $chunk )
1055 Prepare a chunk of data before sending it to HTTP::Body.
1059 sub prepare_body_chunk {
1061 $c->engine->prepare_body_chunk( $c, @_ );
1064 =item $c->prepare_body_parameters
1066 Prepare body parameters.
1070 sub prepare_body_parameters {
1072 $c->engine->prepare_body_parameters( $c, @_ );
1075 =item $c->prepare_connection
1081 sub prepare_connection {
1083 $c->engine->prepare_connection( $c, @_ );
1086 =item $c->prepare_cookies
1092 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1094 =item $c->prepare_headers
1100 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1102 =item $c->prepare_parameters
1108 sub prepare_parameters {
1110 $c->prepare_body_parameters;
1111 $c->engine->prepare_parameters( $c, @_ );
1114 =item $c->prepare_path
1116 Prepare path and base.
1120 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1122 =item $c->prepare_query_parameters
1124 Prepare query parameters.
1128 sub prepare_query_parameters {
1131 $c->engine->prepare_query_parameters( $c, @_ );
1133 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1134 my $t = Text::ASCIITable->new;
1135 $t->setCols( 'Key', 'Value' );
1136 $t->setColWidth( 'Key', 37, 1 );
1137 $t->setColWidth( 'Value', 36, 1 );
1138 $t->alignCol( 'Value', 'right' );
1139 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1140 my $param = $c->req->query_parameters->{$key};
1141 my $value = defined($param) ? $param : '';
1143 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1145 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1149 =item $c->prepare_read
1151 Prepare the input for reading.
1155 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1157 =item $c->prepare_request
1159 Prepare the engine request.
1163 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1165 =item $c->prepare_uploads
1171 sub prepare_uploads {
1174 $c->engine->prepare_uploads( $c, @_ );
1176 if ( $c->debug && keys %{ $c->request->uploads } ) {
1177 my $t = Text::ASCIITable->new;
1178 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1179 $t->setColWidth( 'Key', 12, 1 );
1180 $t->setColWidth( 'Filename', 28, 1 );
1181 $t->setColWidth( 'Type', 18, 1 );
1182 $t->setColWidth( 'Size', 9, 1 );
1183 $t->alignCol( 'Size', 'left' );
1184 for my $key ( sort keys %{ $c->request->uploads } ) {
1185 my $upload = $c->request->uploads->{$key};
1186 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1187 $t->addRow( $key, $u->filename, $u->type, $u->size );
1190 $c->log->debug( "File Uploads are:\n" . $t->draw );
1194 =item $c->prepare_write
1196 Prepare the output for writing.
1200 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1202 =item $c->read( [$maxlength] )
1204 Read a chunk of data from the request body. This method is designed to be
1205 used in a while loop, reading $maxlength bytes on every call. $maxlength
1206 defaults to the size of the request if not specified.
1208 You have to set MyApp->config->{parse_on_demand} to use this directly.
1212 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1220 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1222 =item $c->set_action( $action, $code, $namespace, $attrs )
1224 Set an action in a given namespace.
1228 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1230 =item $c->setup_actions($component)
1232 Setup actions for a component.
1236 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1238 =item $c->setup_components
1244 sub setup_components {
1247 my $callback = sub {
1248 my ( $component, $context ) = @_;
1250 unless ( $component->isa('Catalyst::Base') ) {
1254 my $suffix = Catalyst::Utils::class2classsuffix($component);
1255 my $config = $class->config->{$suffix} || {};
1259 eval { $instance = $component->new( $context, $config ); };
1261 if ( my $error = $@ ) {
1265 Catalyst::Exception->throw( message =>
1266 qq/Couldn't instantiate component "$component", "$error"/ );
1269 Catalyst::Exception->throw( message =>
1270 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1272 unless ref $instance;
1277 Module::Pluggable::Fast->import(
1278 name => '_catalyst_components',
1280 "$class\::Controller", "$class\::C",
1281 "$class\::Model", "$class\::M",
1282 "$class\::View", "$class\::V"
1284 callback => $callback
1288 if ( my $error = $@ ) {
1292 Catalyst::Exception->throw(
1293 message => qq/Couldn't load components "$error"/ );
1296 for my $component ( $class->_catalyst_components($class) ) {
1297 $class->components->{ ref $component || $component } = $component;
1301 =item $c->setup_dispatcher
1305 sub setup_dispatcher {
1306 my ( $class, $dispatcher ) = @_;
1309 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1312 if ( $ENV{CATALYST_DISPATCHER} ) {
1313 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1316 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1318 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1321 unless ($dispatcher) {
1322 $dispatcher = 'Catalyst::Dispatcher';
1325 $dispatcher->require;
1328 Catalyst::Exception->throw(
1329 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1332 # dispatcher instance
1333 $class->dispatcher( $dispatcher->new );
1336 =item $c->setup_engine
1341 my ( $class, $engine ) = @_;
1344 $engine = 'Catalyst::Engine::' . $engine;
1347 if ( $ENV{CATALYST_ENGINE} ) {
1348 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1351 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1352 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1355 if ( !$engine && $ENV{MOD_PERL} ) {
1357 # create the apache method
1360 *{"$class\::apache"} = sub { shift->engine->apache };
1363 my ( $software, $version ) =
1364 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1367 $version =~ s/(\.[^.]+)\./$1/g;
1369 if ( $software eq 'mod_perl' ) {
1371 if ( $version >= 1.99922 ) {
1372 $engine = 'Catalyst::Engine::Apache2::MP20';
1375 elsif ( $version >= 1.9901 ) {
1376 $engine = 'Catalyst::Engine::Apache2::MP19';
1379 elsif ( $version >= 1.24 ) {
1380 $engine = 'Catalyst::Engine::Apache::MP13';
1384 Catalyst::Exception->throw( message =>
1385 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1388 # install the correct mod_perl handler
1389 if ( $version >= 1.9901 ) {
1390 *handler = sub : method {
1391 shift->handle_request(@_);
1395 *handler = sub ($$) { shift->handle_request(@_) };
1400 elsif ( $software eq 'Zeus-Perl' ) {
1401 $engine = 'Catalyst::Engine::Zeus';
1405 Catalyst::Exception->throw(
1406 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1411 $engine = 'Catalyst::Engine::CGI';
1417 Catalyst::Exception->throw( message =>
1418 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1423 $class->engine( $engine->new );
1426 =item $c->setup_home
1431 my ( $class, $home ) = @_;
1433 if ( $ENV{CATALYST_HOME} ) {
1434 $home = $ENV{CATALYST_HOME};
1437 if ( $ENV{ uc($class) . '_HOME' } ) {
1438 $home = $ENV{ uc($class) . '_HOME' };
1442 $home = Catalyst::Utils::home($class);
1446 $class->config->{home} ||= $home;
1447 $class->config->{root} ||= dir($home)->subdir('root');
1456 my ( $class, $debug ) = @_;
1458 unless ( $class->log ) {
1459 $class->log( Catalyst::Log->new );
1462 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1464 *{"$class\::debug"} = sub { 1 };
1465 $class->log->debug('Debug messages enabled');
1469 =item $c->setup_plugins
1474 my ( $class, $plugins ) = @_;
1477 for my $plugin ( reverse @$plugins ) {
1479 $plugin = "Catalyst::Plugin::$plugin";
1484 Catalyst::Exception->throw(
1485 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1490 unshift @{"$class\::ISA"}, $plugin;
1495 =item $c->write( $data )
1497 Writes $data to the output stream. When using this method directly, you will
1498 need to manually set the Content-Length header to the length of your output
1506 # Finalize headers if someone manually writes output
1507 $c->finalize_headers;
1509 return $c->engine->write( $c, @_ );
1514 =head1 CASE SENSITIVITY
1516 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1519 But you can activate case sensitivity with a config parameter.
1521 MyApp->config->{case_sensitive} = 1;
1523 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1525 =head1 ON-DEMAND PARSER
1527 The request body is usually parsed at the beginning of a request,
1528 but if you want to handle input yourself or speed things up a bit
1529 you can enable on-demand parsing with a config parameter.
1531 MyApp->config->{parse_on_demand} = 1;
1533 =head1 PROXY SUPPORT
1535 Many production servers operate using the common double-server approach, with
1536 a lightweight frontend web server passing requests to a larger backend
1537 server. An application running on the backend server must deal with two
1538 problems: the remote user always appears to be '127.0.0.1' and the server's
1539 hostname will appear to be 'localhost' regardless of the virtual host the
1540 user connected through.
1542 Catalyst will automatically detect this situation when you are running both
1543 the frontend and backend servers on the same machine. The following changes
1544 are made to the request.
1546 $c->req->address is set to the user's real IP address, as read from the
1547 HTTP_X_FORWARDED_FOR header.
1549 The host value for $c->req->base and $c->req->uri is set to the real host,
1550 as read from the HTTP_X_FORWARDED_HOST header.
1552 Obviously, your web server must support these 2 headers for this to work.
1554 In a more complex server farm environment where you may have your frontend
1555 proxy server(s) on different machines, you will need to set a configuration
1556 option to tell Catalyst to read the proxied data from the headers.
1558 MyApp->config->{using_frontend_proxy} = 1;
1560 If you do not wish to use the proxy support at all, you may set:
1562 MyApp->config->{ignore_frontend_proxy} = 1;
1564 =head1 THREAD SAFETY
1566 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1567 and the standalone forking HTTP server on Windows. We believe the Catalyst
1568 core to be thread-safe.
1570 If you plan to operate in a threaded environment, remember that all other
1571 modules you are using must also be thread-safe. Some modules, most notably
1572 DBD::SQLite, are not thread-safe.
1578 Join #catalyst on irc.perl.org.
1582 http://lists.rawmode.org/mailman/listinfo/catalyst
1583 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1587 http://catalyst.perl.org
1593 =item L<Catalyst::Manual> - The Catalyst Manual
1595 =item L<Catalyst::Engine> - Core Engine
1597 =item L<Catalyst::Log> - The Log Class.
1599 =item L<Catalyst::Request> - The Request Object
1601 =item L<Catalyst::Response> - The Response Object
1603 =item L<Catalyst::Test> - The test suite.
1665 Sebastian Riedel, C<sri@oook.de>
1669 This library is free software . You can redistribute it and/or modify it under
1670 the same terms as Perl itself.