4 use base 'Catalyst::Base';
6 use UNIVERSAL::require;
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
14 use Text::SimpleTable;
16 use Time::HiRes qw/gettimeofday tv_interval/;
18 use Scalar::Util qw/weaken/;
21 __PACKAGE__->mk_accessors(
22 qw/counter request response state action stack namespace/
25 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
27 sub depth { scalar @{shift->stack||[]}; }
28 #sub namespace { my $a = shift->stack->[-1]; ($a ? $a->namespace : ''); }
35 # For backwards compatibility
36 *finalize_output = \&finalize_body;
41 our $RECURSION = 1000;
42 our $DETACH = "catalyst_detach\n";
44 require Module::Pluggable::Fast;
46 # Helper script generation
47 our $CATALYST_SCRIPT_GEN = 10;
49 __PACKAGE__->mk_classdata($_)
50 for qw/components arguments dispatcher engine log dispatcher_class
51 engine_class context_class request_class response_class/;
53 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
54 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
55 __PACKAGE__->request_class('Catalyst::Request');
56 __PACKAGE__->response_class('Catalyst::Response');
58 our $VERSION = '5.49_03';
61 my ( $class, @arguments ) = @_;
63 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
65 return unless $class eq 'Catalyst';
67 my $caller = caller(0);
69 unless ( $caller->isa('Catalyst') ) {
71 push @{"$caller\::ISA"}, $class;
74 $caller->arguments( [@arguments] );
80 Catalyst - The Elegant MVC Web Application Framework
84 # use the helper to start a new application
88 # add models, views, controllers
89 script/myapp_create.pl model Something
90 script/myapp_create.pl view Stuff
91 script/myapp_create.pl controller Yada
94 script/myapp_server.pl
96 # command line interface
97 script/myapp_test.pl /yada
102 use Catalyst qw/My::Module My::OtherModule/;
104 use Catalyst '-Debug';
106 use Catalyst qw/-Debug -Engine=CGI/;
108 sub default : Private { $_[1]->res->output('Hello') } );
110 sub index : Path('/index.html') {
111 my ( $self, $c ) = @_;
112 $c->res->output('Hello');
116 sub product : Regex('^product[_]*(\d*).html$') {
117 my ( $self, $c ) = @_;
118 $c->stash->{template} = 'product.tt';
119 $c->stash->{product} = $c->req->snippets->[0];
122 See also L<Catalyst::Manual::Intro>
126 The key concept of Catalyst is DRY (Don't Repeat Yourself).
128 See L<Catalyst::Manual> for more documentation.
130 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
131 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
132 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
134 use Catalyst 'My::Module';
136 Special flags like -Debug and -Engine can also be specified as arguments when
139 use Catalyst qw/-Debug My::Module/;
141 The position of plugins and flags in the chain is important, because they are
142 loaded in exactly the order that they appear.
144 The following flags are supported:
150 enables debug output, i.e.:
152 use Catalyst '-Debug';
154 this is equivalent to:
161 Force Catalyst to use a specific dispatcher.
165 Force Catalyst to use a specific engine.
166 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
168 use Catalyst '-Engine=CGI';
172 Force Catalyst to use a specific home directory.
186 Accessor for the current action
188 =item $c->comp($name)
190 =item $c->component($name)
192 Get a component object by name.
194 $c->comp('MyApp::Model::MyModel')->do_stuff;
205 my $appclass = ref $c || $c;
208 $name, "${appclass}::${name}",
209 map { "${appclass}::${_}::${name}" } qw/M V C/
212 foreach my $try (@names) {
214 if ( exists $c->components->{$try} ) {
216 return $c->components->{$try};
220 foreach my $component ( keys %{ $c->components } ) {
222 return $c->components->{$component} if $component =~ /$name/i;
227 return sort keys %{ $c->components };
232 Returns a hashref containing your applications settings.
236 =item $c->controller($name)
238 Get a L<Catalyst::Controller> instance by name.
240 $c->controller('Foo')->do_stuff;
245 my ( $c, $name ) = @_;
246 my $controller = $c->comp("Controller::$name");
247 return $controller if $controller;
248 return $c->comp("C::$name");
253 Overload to enable debug messages.
259 =item $c->detach( $command [, \@arguments ] )
261 Like C<forward> but doesn't return.
265 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
269 Contains the dispatcher instance.
270 Stringifies to class.
272 =item $c->forward( $command [, \@arguments ] )
274 Forward processing to a private action or a method from a class.
275 If you define a class without method it will default to process().
276 also takes an optional arrayref containing arguments to be passed
277 to the new function. $c->req->args will be reset upon returning
281 $c->forward('index');
282 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
283 $c->forward('MyApp::View::TT');
287 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
289 =item $c->model($name)
291 Get a L<Catalyst::Model> instance by name.
293 $c->model('Foo')->do_stuff;
298 my ( $c, $name ) = @_;
299 my $model = $c->comp("Model::$name");
300 return $model if $model;
301 return $c->comp("M::$name");
306 Accessor to the namespace of the current action
308 =item $c->path_to(@path)
310 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
314 $c->path_to( 'db', 'sqlite.db' );
319 my ( $c, @path ) = @_;
320 my $path = dir( $c->config->{home}, @path );
321 if ( -d $path ) { return $path }
322 else { return file( $c->config->{home}, @path ) }
334 my ( $class, @arguments ) = @_;
336 unless ( $class->isa('Catalyst') ) {
338 Catalyst::Exception->throw(
339 message => qq/'$class' does not inherit from Catalyst/ );
342 if ( $class->arguments ) {
343 @arguments = ( @arguments, @{ $class->arguments } );
349 foreach (@arguments) {
353 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
355 elsif (/^-(\w+)=?(.*)$/) {
356 $flags->{ lc $1 } = $2;
359 push @{ $flags->{plugins} }, $_;
363 $class->setup_log( delete $flags->{log} );
364 $class->setup_plugins( delete $flags->{plugins} );
365 $class->setup_dispatcher( delete $flags->{dispatcher} );
366 $class->setup_engine( delete $flags->{engine} );
367 $class->setup_home( delete $flags->{home} );
369 for my $flag ( sort keys %{$flags} ) {
371 if ( my $code = $class->can( 'setup_' . $flag ) ) {
372 &$code( $class, delete $flags->{$flag} );
375 $class->log->warn(qq/Unknown flag "$flag"/);
379 $class->log->warn( "You are running an old helper script! "
380 . "Please update your scripts by regenerating the "
381 . "application and copying over the new scripts." )
382 if ( $ENV{CATALYST_SCRIPT_GEN}
383 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
385 if ( $class->debug ) {
391 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
395 my $t = Text::SimpleTable->new(76);
396 $t->row($_) for @plugins;
397 $class->log->debug( "Loaded plugins:\n" . $t->draw );
400 my $dispatcher = $class->dispatcher;
401 my $engine = $class->engine;
402 my $home = $class->config->{home};
404 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
405 $class->log->debug(qq/Loaded engine "$engine"/);
409 ? $class->log->debug(qq/Found home "$home"/)
410 : $class->log->debug(qq/Home "$home" doesn't exist/)
411 : $class->log->debug(q/Couldn't find home/);
416 no warnings qw/redefine/;
417 local *setup = sub { };
421 # Initialize our data structure
422 $class->components( {} );
424 $class->setup_components;
426 if ( $class->debug ) {
427 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
428 for my $comp ( sort keys %{ $class->components } ) {
429 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
430 $t->row( $comp, $type );
432 $class->log->debug( "Loaded components:\n" . $t->draw )
433 if ( keys %{ $class->components } );
436 # Add our self to components, since we are also a component
437 $class->components->{$class} = $class;
439 $class->setup_actions;
441 if ( $class->debug ) {
442 my $name = $class->config->{name} || 'Application';
443 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
445 $class->log->_flush() if $class->log->can('_flush');
448 =item $c->uri_for($path,[@args])
450 Merges path with $c->request->base for absolute uri's and with
451 $c->request->match for relative uri's, then returns a normalized
452 L<URI> object. If any args are passed, they are added at the end
458 my ( $c, $path, @args ) = @_;
459 my $base = $c->request->base->clone;
460 my $basepath = $base->path;
461 $basepath =~ s/\/$//;
463 my $match = $c->request->match;
465 # massage match, empty if absolute path
467 $match .= '/' if $match;
469 $match = '' if $path =~ /^\//;
472 # join args with '/', or a blank string
473 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
474 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
480 =item $c->error($error, ...)
482 =item $c->error($arrayref)
484 Returns an arrayref containing error messages.
486 my @error = @{ $c->error };
490 $c->error('Something bad happened');
501 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
502 push @{ $c->{error} }, @$error;
504 elsif ( defined $_[0] ) { $c->{error} = undef }
505 return $c->{error} || [];
510 Contains the engine instance.
511 Stringifies to the class.
515 Contains the logging object. Unless it is already set Catalyst sets this up with a
516 C<Catalyst::Log> object. To use your own log class:
518 $c->log( MyLogger->new );
519 $c->log->info("now logging with my own logger!");
521 Your log class should implement the methods described in the C<Catalyst::Log>
524 =item $c->plugin( $name, $class, @args )
526 Instant plugins for Catalyst.
527 Classdata accessor/mutator will be created, class loaded and instantiated.
529 MyApp->plugin( 'prototype', 'HTML::Prototype' );
531 $c->prototype->define_javascript_functions;
536 my ( $class, $name, $plugin, @args ) = @_;
539 if ( my $error = $UNIVERSAL::require::ERROR ) {
540 Catalyst::Exception->throw(
541 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
544 eval { $plugin->import };
545 $class->mk_classdata($name);
547 eval { $obj = $plugin->new(@args) };
550 Catalyst::Exception->throw( message =>
551 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
555 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
563 Returns a C<Catalyst::Request> object.
571 Returns a C<Catalyst::Response> object.
577 Contains the return value of the last executed action.
581 Returns a hashref containing all your data.
583 print $c->stash->{foo};
585 Keys may be set in the stash by assigning to the hash reference, or by passing
586 either a single hash reference or a list of key/value pairs as arguments.
590 $c->stash->{foo} ||= 'yada';
591 $c->stash( { moose => 'majestic', qux => 0 } );
592 $c->stash( bar => 1, gorch => 2 );
599 my $stash = @_ > 1 ? {@_} : $_[0];
600 while ( my ( $key, $val ) = each %$stash ) {
601 $c->{stash}->{$key} = $val;
607 =item $c->view($name)
609 Get a L<Catalyst::View> instance by name.
611 $c->view('Foo')->do_stuff;
616 my ( $c, $name ) = @_;
617 my $view = $c->comp("View::$name");
618 return $view if $view;
619 return $c->comp("V::$name");
622 =item $c->welcome_message
624 Returns the Catalyst welcome HTML page.
628 sub welcome_message {
630 my $name = $c->config->{name};
631 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
632 my $prefix = Catalyst::Utils::appprefix( ref $c );
633 $c->response->content_type('text/html; charset=utf-8');
635 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
636 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
637 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
639 <meta http-equiv="Content-Language" content="en" />
640 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
641 <title>$name on Catalyst $VERSION</title>
642 <style type="text/css">
645 background-color: #eee;
654 background-color: #ccc;
655 border: 1px solid #aaa;
656 -moz-border-radius: 10px;
661 font-family: verdana, tahoma, sans-serif;
664 font-family: verdana, tahoma, sans-serif;
667 text-decoration: none;
669 border-bottom: 1px dotted #bbb;
671 :link:hover, :visited:hover {
684 background-color: #fff;
685 border: 1px solid #aaa;
686 -moz-border-radius: 10px;
712 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
717 <img src="$logo" alt="Catalyst Logo" />
719 <p>Welcome to the wonderful world of Catalyst.
720 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
721 framework will make web development something you had
722 never expected it to be: Fun, rewarding and quick.</p>
723 <h2>What to do now?</h2>
724 <p>That really depends on what <b>you</b> want to do.
725 We do, however, provide you with a few starting points.</p>
726 <p>If you want to jump right into web development with Catalyst
727 you might want to check out the documentation.</p>
728 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
729 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
730 <h2>What to do next?</h2>
731 <p>Next it's time to write an actual application. Use the
732 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
733 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
734 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
735 they can save you a lot of work.</p>
736 <pre><code>script/${prefix}_create.pl -help</code></pre>
737 <p>Also, be sure to check out the vast and growing
738 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
739 you are likely to find what you need there.
743 <p>Catalyst has a very active community. Here are the main places to
744 get in touch with us.</p>
747 <a href="http://dev.catalyst.perl.org">Wiki</a>
750 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
753 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
756 <h2>In conclusion</h2>
757 <p>The Catalyst team hopes you will enjoy using Catalyst as much
758 as we enjoyed making it. Please contact us if you have ideas
759 for improvement or other feedback.</p>
769 =head1 INTERNAL METHODS
773 =item $c->benchmark($coderef)
775 Takes a coderef with arguments and returns elapsed time as float.
777 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
778 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
785 my $time = [gettimeofday];
786 my @return = &$code(@_);
787 my $elapsed = tv_interval $time;
788 return wantarray ? ( $elapsed, @return ) : $elapsed;
793 Contains the components.
795 =item $c->context_class($class)
797 Contains the context class.
801 Returns a hashref containing coderefs and execution counts.
802 (Needed for deep recursion detection)
806 Returns the actual forward depth.
810 Dispatch request to actions.
814 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
816 =item $c->dispatcher_class($class)
818 Contains the dispatcher class.
822 Returns a list of 2-element array references (name, structure) pairs that will
823 be dumped on the error page in debug mode.
829 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
832 =item $c->engine_class($class)
834 Contains the engine class.
836 =item $c->execute($class, $coderef)
838 Execute a coderef in given class and catch exceptions.
839 Errors are available via $c->error.
844 my ( $c, $class, $code ) = @_;
845 $class = $c->components->{$class} || $class;
847 my $callsub = ( caller(1) )[3];
852 $action = "/$action" unless $action =~ /\-\>/;
853 $c->counter->{"$code"}++;
855 if ( $c->counter->{"$code"} > $RECURSION ) {
856 my $error = qq/Deep recursion detected in "$action"/;
857 $c->log->error($error);
863 $action = "-> $action" if $callsub =~ /forward$/;
865 push(@{$c->stack}, $code);
869 my ( $elapsed, @state ) =
870 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
871 unless ( ( $code->name =~ /^_.*/ )
872 && ( !$c->config->{show_internal_actions} ) )
874 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
879 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
884 if ( my $error = $@ ) {
886 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
888 unless ( ref $error ) {
890 $error = qq/Caught exception "$error"/;
908 for my $error ( @{ $c->error } ) {
909 $c->log->error($error);
912 $c->finalize_uploads;
915 if ( $#{ $c->error } >= 0 ) {
919 $c->finalize_headers;
922 if ( $c->request->method eq 'HEAD' ) {
923 $c->response->body('');
928 return $c->response->status;
931 =item $c->finalize_body
937 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
939 =item $c->finalize_cookies
945 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
947 =item $c->finalize_error
953 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
955 =item $c->finalize_headers
961 sub finalize_headers {
964 # Check if we already finalized headers
965 return if $c->response->{_finalized_headers};
968 if ( my $location = $c->response->redirect ) {
969 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
970 $c->response->header( Location => $location );
974 if ( $c->response->body && !$c->response->content_length ) {
975 $c->response->content_length( bytes::length( $c->response->body ) );
979 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
980 $c->response->headers->remove_header("Content-Length");
981 $c->response->body('');
984 $c->finalize_cookies;
986 $c->engine->finalize_headers( $c, @_ );
989 $c->response->{_finalized_headers} = 1;
992 =item $c->finalize_output
994 An alias for finalize_body.
996 =item $c->finalize_read
998 Finalize the input after reading is complete.
1002 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1004 =item $c->finalize_uploads
1006 Finalize uploads. Cleans up any temporary files.
1010 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1012 =item $c->get_action( $action, $namespace )
1014 Get an action in a given namespace.
1018 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1020 =item $c->get_actions( $action, $namespace )
1022 Get all actions of a given name in a namespace and all base namespaces.
1026 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1028 =item handle_request( $class, @arguments )
1030 Handles the request.
1034 sub handle_request {
1035 my ( $class, @arguments ) = @_;
1037 # Always expect worst case!
1043 my $c = $class->prepare(@arguments);
1044 $c->{stats} = \@stats;
1046 return $c->finalize;
1049 if ( $class->debug ) {
1051 ( $elapsed, $status ) = $class->benchmark($handler);
1052 $elapsed = sprintf '%f', $elapsed;
1053 my $av = sprintf '%.3f',
1054 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1055 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1057 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1059 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1061 else { $status = &$handler }
1065 if ( my $error = $@ ) {
1067 $class->log->error(qq/Caught exception in engine "$error"/);
1071 $class->log->_flush() if $class->log->can('_flush');
1075 =item $c->prepare(@arguments)
1077 Turns the engine-specific request( Apache, CGI ... )
1078 into a Catalyst context .
1083 my ( $class, @arguments ) = @_;
1085 $class->context_class( ref $class || $class ) unless $class->context_class;
1086 my $c = $class->context_class->new(
1090 request => $class->request_class->new(
1093 body_parameters => {},
1095 headers => HTTP::Headers->new,
1097 query_parameters => {},
1103 response => $class->response_class->new(
1107 headers => HTTP::Headers->new(),
1116 # For on-demand data
1117 $c->request->{_context} = $c;
1118 $c->response->{_context} = $c;
1119 weaken( $c->request->{_context} );
1120 weaken( $c->response->{_context} );
1123 my $secs = time - $START || 1;
1124 my $av = sprintf '%.3f', $COUNT / $secs;
1125 $c->log->debug('**********************************');
1126 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1127 $c->log->debug('**********************************');
1128 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1131 $c->prepare_request(@arguments);
1132 $c->prepare_connection;
1133 $c->prepare_query_parameters;
1134 $c->prepare_headers;
1135 $c->prepare_cookies;
1139 $c->prepare_body unless $c->config->{parse_on_demand};
1142 my $method = $c->req->method || '';
1143 my $path = $c->req->path || '';
1144 my $address = $c->req->address || '';
1146 $c->log->debug(qq/"$method" request for "$path" from $address/)
1152 =item $c->prepare_action
1158 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1160 =item $c->prepare_body
1162 Prepare message body.
1169 # Do we run for the first time?
1170 return if defined $c->request->{_body};
1172 # Initialize on-demand data
1173 $c->engine->prepare_body( $c, @_ );
1174 $c->prepare_parameters;
1175 $c->prepare_uploads;
1177 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1178 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1179 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1180 my $param = $c->req->body_parameters->{$key};
1181 my $value = defined($param) ? $param : '';
1183 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1185 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1189 =item $c->prepare_body_chunk( $chunk )
1191 Prepare a chunk of data before sending it to HTTP::Body.
1195 sub prepare_body_chunk {
1197 $c->engine->prepare_body_chunk( $c, @_ );
1200 =item $c->prepare_body_parameters
1202 Prepare body parameters.
1206 sub prepare_body_parameters {
1208 $c->engine->prepare_body_parameters( $c, @_ );
1211 =item $c->prepare_connection
1217 sub prepare_connection {
1219 $c->engine->prepare_connection( $c, @_ );
1222 =item $c->prepare_cookies
1228 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1230 =item $c->prepare_headers
1236 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1238 =item $c->prepare_parameters
1244 sub prepare_parameters {
1246 $c->prepare_body_parameters;
1247 $c->engine->prepare_parameters( $c, @_ );
1250 =item $c->prepare_path
1252 Prepare path and base.
1256 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1258 =item $c->prepare_query_parameters
1260 Prepare query parameters.
1264 sub prepare_query_parameters {
1267 $c->engine->prepare_query_parameters( $c, @_ );
1269 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1270 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1271 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1272 my $param = $c->req->query_parameters->{$key};
1273 my $value = defined($param) ? $param : '';
1275 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1277 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1281 =item $c->prepare_read
1283 Prepare the input for reading.
1287 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1289 =item $c->prepare_request
1291 Prepare the engine request.
1295 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1297 =item $c->prepare_uploads
1303 sub prepare_uploads {
1306 $c->engine->prepare_uploads( $c, @_ );
1308 if ( $c->debug && keys %{ $c->request->uploads } ) {
1309 my $t = Text::SimpleTable->new(
1315 for my $key ( sort keys %{ $c->request->uploads } ) {
1316 my $upload = $c->request->uploads->{$key};
1317 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1318 $t->row( $key, $u->filename, $u->type, $u->size );
1321 $c->log->debug( "File Uploads are:\n" . $t->draw );
1325 =item $c->prepare_write
1327 Prepare the output for writing.
1331 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1333 =item $c->request_class($class)
1335 Contains the request class.
1337 =item $c->response_class($class)
1339 Contains the response class.
1341 =item $c->read( [$maxlength] )
1343 Read a chunk of data from the request body. This method is designed to be
1344 used in a while loop, reading $maxlength bytes on every call. $maxlength
1345 defaults to the size of the request if not specified.
1347 You have to set MyApp->config->{parse_on_demand} to use this directly.
1351 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1359 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1361 =item $c->set_action( $action, $code, $namespace, $attrs )
1363 Set an action in a given namespace.
1367 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1369 =item $c->setup_actions($component)
1371 Setup actions for a component.
1375 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1377 =item $c->setup_components
1383 sub setup_components {
1386 my $callback = sub {
1387 my ( $component, $context ) = @_;
1389 unless ( $component->isa('Catalyst::Component') ) {
1393 my $suffix = Catalyst::Utils::class2classsuffix($class);
1394 my $config = $class->config->{$suffix} || {};
1398 eval { $instance = $component->new( $context, $config ); };
1400 if ( my $error = $@ ) {
1404 Catalyst::Exception->throw( message =>
1405 qq/Couldn't instantiate component "$component", "$error"/ );
1408 Catalyst::Exception->throw( message =>
1409 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1411 unless ref $instance;
1416 Module::Pluggable::Fast->import(
1417 name => '_catalyst_components',
1419 "$class\::Controller", "$class\::C",
1420 "$class\::Model", "$class\::M",
1421 "$class\::View", "$class\::V"
1423 callback => $callback
1427 if ( my $error = $@ ) {
1431 Catalyst::Exception->throw(
1432 message => qq/Couldn't load components "$error"/ );
1435 for my $component ( $class->_catalyst_components($class) ) {
1436 $class->components->{ ref $component || $component } = $component;
1440 =item $c->setup_dispatcher
1444 sub setup_dispatcher {
1445 my ( $class, $dispatcher ) = @_;
1448 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1451 if ( $ENV{CATALYST_DISPATCHER} ) {
1452 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1455 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1457 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1460 unless ($dispatcher) {
1461 $dispatcher = $class->dispatcher_class;
1464 $dispatcher->require;
1467 Catalyst::Exception->throw(
1468 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1471 # dispatcher instance
1472 $class->dispatcher( $dispatcher->new );
1475 =item $c->setup_engine
1480 my ( $class, $engine ) = @_;
1483 $engine = 'Catalyst::Engine::' . $engine;
1486 if ( $ENV{CATALYST_ENGINE} ) {
1487 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1490 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1491 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1494 if ( !$engine && $ENV{MOD_PERL} ) {
1496 # create the apache method
1499 *{"$class\::apache"} = sub { shift->engine->apache };
1502 my ( $software, $version ) =
1503 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1506 $version =~ s/(\.[^.]+)\./$1/g;
1508 if ( $software eq 'mod_perl' ) {
1510 if ( $version >= 1.99922 ) {
1511 $engine = 'Catalyst::Engine::Apache2::MP20';
1514 elsif ( $version >= 1.9901 ) {
1515 $engine = 'Catalyst::Engine::Apache2::MP19';
1518 elsif ( $version >= 1.24 ) {
1519 $engine = 'Catalyst::Engine::Apache::MP13';
1523 Catalyst::Exception->throw( message =>
1524 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1527 # install the correct mod_perl handler
1528 if ( $version >= 1.9901 ) {
1529 *handler = sub : method {
1530 shift->handle_request(@_);
1534 *handler = sub ($$) { shift->handle_request(@_) };
1539 elsif ( $software eq 'Zeus-Perl' ) {
1540 $engine = 'Catalyst::Engine::Zeus';
1544 Catalyst::Exception->throw(
1545 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1550 $engine = $class->engine_class;
1556 Catalyst::Exception->throw( message =>
1557 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1561 # check for old engines that are no longer compatible
1563 if ( $engine->isa('Catalyst::Engine::Apache')
1564 && !Catalyst::Engine::Apache->VERSION )
1569 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1570 && Catalyst::Engine::Server->VERSION le '0.02' )
1575 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1576 && $engine->VERSION eq '0.01' )
1581 elsif ($engine->isa('Catalyst::Engine::Zeus')
1582 && $engine->VERSION eq '0.01' )
1588 Catalyst::Exception->throw( message =>
1589 qq/Engine "$engine" is not supported by this version of Catalyst/
1594 $class->engine( $engine->new );
1597 =item $c->setup_home
1602 my ( $class, $home ) = @_;
1604 if ( $ENV{CATALYST_HOME} ) {
1605 $home = $ENV{CATALYST_HOME};
1608 if ( $ENV{ uc($class) . '_HOME' } ) {
1609 $home = $ENV{ uc($class) . '_HOME' };
1613 $home = Catalyst::Utils::home($class);
1617 $class->config->{home} ||= $home;
1618 $class->config->{root} ||= dir($home)->subdir('root');
1627 my ( $class, $debug ) = @_;
1629 unless ( $class->log ) {
1630 $class->log( Catalyst::Log->new );
1633 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1636 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1637 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1642 *{"$class\::debug"} = sub { 1 };
1643 $class->log->debug('Debug messages enabled');
1647 =item $c->setup_plugins
1652 my ( $class, $plugins ) = @_;
1655 for my $plugin ( reverse @$plugins ) {
1657 $plugin = "Catalyst::Plugin::$plugin";
1662 Catalyst::Exception->throw(
1663 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1668 unshift @{"$class\::ISA"}, $plugin;
1673 =item $c->write( $data )
1675 Writes $data to the output stream. When using this method directly, you will
1676 need to manually set the Content-Length header to the length of your output
1684 # Finalize headers if someone manually writes output
1685 $c->finalize_headers;
1687 return $c->engine->write( $c, @_ );
1692 Returns the Catalyst version number. mostly useful for powered by messages
1693 in template systems.
1697 sub version { return $Catalyst::VERSION }
1701 =head1 INTERNAL ACTIONS
1703 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1704 C<_ACTION> and C<_END>, these are by default not shown in the private
1707 But you can deactivate this with a config parameter.
1709 MyApp->config->{show_internal_actions} = 1;
1711 =head1 CASE SENSITIVITY
1713 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1716 But you can activate case sensitivity with a config parameter.
1718 MyApp->config->{case_sensitive} = 1;
1720 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1722 =head1 ON-DEMAND PARSER
1724 The request body is usually parsed at the beginning of a request,
1725 but if you want to handle input yourself or speed things up a bit
1726 you can enable on-demand parsing with a config parameter.
1728 MyApp->config->{parse_on_demand} = 1;
1730 =head1 PROXY SUPPORT
1732 Many production servers operate using the common double-server approach, with
1733 a lightweight frontend web server passing requests to a larger backend
1734 server. An application running on the backend server must deal with two
1735 problems: the remote user always appears to be '127.0.0.1' and the server's
1736 hostname will appear to be 'localhost' regardless of the virtual host the
1737 user connected through.
1739 Catalyst will automatically detect this situation when you are running both
1740 the frontend and backend servers on the same machine. The following changes
1741 are made to the request.
1743 $c->req->address is set to the user's real IP address, as read from the
1744 HTTP_X_FORWARDED_FOR header.
1746 The host value for $c->req->base and $c->req->uri is set to the real host,
1747 as read from the HTTP_X_FORWARDED_HOST header.
1749 Obviously, your web server must support these 2 headers for this to work.
1751 In a more complex server farm environment where you may have your frontend
1752 proxy server(s) on different machines, you will need to set a configuration
1753 option to tell Catalyst to read the proxied data from the headers.
1755 MyApp->config->{using_frontend_proxy} = 1;
1757 If you do not wish to use the proxy support at all, you may set:
1759 MyApp->config->{ignore_frontend_proxy} = 1;
1761 =head1 THREAD SAFETY
1763 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1764 and the standalone forking HTTP server on Windows. We believe the Catalyst
1765 core to be thread-safe.
1767 If you plan to operate in a threaded environment, remember that all other
1768 modules you are using must also be thread-safe. Some modules, most notably
1769 DBD::SQLite, are not thread-safe.
1775 Join #catalyst on irc.perl.org.
1779 http://lists.rawmode.org/mailman/listinfo/catalyst
1780 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1784 http://catalyst.perl.org
1790 =item L<Catalyst::Manual> - The Catalyst Manual
1792 =item L<Catalyst::Engine> - Core Engine
1794 =item L<Catalyst::Log> - The Log Class.
1796 =item L<Catalyst::Request> - The Request Object
1798 =item L<Catalyst::Response> - The Response Object
1800 =item L<Catalyst::Test> - The test suite.
1868 Sebastian Riedel, C<sri@oook.de>
1872 This library is free software, you can redistribute it and/or modify it under
1873 the same terms as Perl itself.