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 =head1 $c->welcome_message
529 Returns the Catalyst welcome HTML page.
533 sub welcome_message {
535 my $name = $c->config->{name};
539 <title>$name on Catalyst $VERSION</title>
540 <style type="text/css">
545 background-color: #eee;
553 background-color: #ccc;
554 border: 1px solid #aaa;
555 -moz-border-radius: 10px;
560 font-family: verdana, tahoma, sans-serif;
563 font-family: verdana, tahoma, sans-serif;
566 text-decoration: none;
568 border-bottom: 1px dotted #bbb;
570 :link:hover, :visited:hover {
577 border: 1px dotted #555;
584 background-color: #fff;
585 border: 1px solid #aaa;
586 -moz-border-radius: 10px;
607 <h1>$name on <a href="http://catalyst.perl.org">Catalyst</a>
611 <p>Welcome to the wonderful world of Catalyst.
612 This MVC framework will make web development
613 something you had never expected it to be:
614 Fun, rewarding and quick.</p>
615 <h2>What to do now?</h2>
616 <p>That really depends on what <b>you</b> want to do.
617 We do, however, provide you with a few starting points.</p>
618 <p>If you want to jump right into web development with Catalyst
619 you might want to check out the documentation.</p>
620 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a>
621 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a></code></pre>
622 <p>If you would like some background information on the
623 MVC-pattern, these links might be of help to you.</p>
626 <a href="http://dev.catalyst.perl.org/wiki/Models">
627 Introduction to Models
631 <a href="http://dev.catalyst.perl.org/wiki/Views">
632 Introduction to Views
636 <a href="http://dev.catalyst.perl.org/wiki/Controllers">
637 Introduction to Controllers
641 <h2>What to do next?</h2>
642 <p>Next you need to create an actual application. Use the
643 helper scripts for what they are worth, they can save you
644 a lot of work getting everything set up. Also, be sure to
645 check out the vast array of plugins for Catalyst on CPAN.
646 They can handle everything from A to Z
647 , and a whole lot in between.</p>
649 <p>Catalyst has a very active community. The main places to get
650 in touch are these.</p>
653 <a href="http://dev.catalyst.perl.org">Wiki</a>
656 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
659 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
662 <h2>In conclusion</h2>
663 <p>The Catalyst team hope you will enjoy using Catalyst as much
664 as we enjoyed making it, and rest assured that any and all
665 feedback is welcomed.</p>
666 <p class="signature">-- #1. the first rule of the Cabal is, you do not
667 talk about the Cabal.<br/>
668 #2. the second rule of the Cabal is, you DO NOT
669 talk about the Cabal.</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.
1671 Sebastian Riedel, C<sri@oook.de>
1675 This library is free software . You can redistribute it and/or modify it under
1676 the same terms as perl itself.