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 || [] }; }
34 # For backwards compatibility
35 *finalize_output = \&finalize_body;
40 our $RECURSION = 1000;
41 our $DETACH = "catalyst_detach\n";
43 require Module::Pluggable::Fast;
45 # Helper script generation
46 our $CATALYST_SCRIPT_GEN = 10;
48 __PACKAGE__->mk_classdata($_)
49 for qw/components arguments dispatcher engine log dispatcher_class
50 engine_class context_class request_class response_class/;
52 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
53 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
54 __PACKAGE__->request_class('Catalyst::Request');
55 __PACKAGE__->response_class('Catalyst::Response');
57 our $VERSION = '5.49_04';
60 my ( $class, @arguments ) = @_;
62 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
64 return unless $class eq 'Catalyst';
66 my $caller = caller(0);
68 unless ( $caller->isa('Catalyst') ) {
70 push @{"$caller\::ISA"}, $class;
73 $caller->arguments( [@arguments] );
79 Catalyst - The Elegant MVC Web Application Framework
83 # use the helper to start a new application
87 # add models, views, controllers
88 script/myapp_create.pl model Something
89 script/myapp_create.pl view Stuff
90 script/myapp_create.pl controller Yada
93 script/myapp_server.pl
95 # command line interface
96 script/myapp_test.pl /yada
101 use Catalyst qw/My::Module My::OtherModule/;
103 use Catalyst '-Debug';
105 use Catalyst qw/-Debug -Engine=CGI/;
107 sub default : Private { $_[1]->res->output('Hello') } );
109 sub index : Path('/index.html') {
110 my ( $self, $c ) = @_;
111 $c->res->output('Hello');
115 sub product : Regex('^product[_]*(\d*).html$') {
116 my ( $self, $c ) = @_;
117 $c->stash->{template} = 'product.tt';
118 $c->stash->{product} = $c->req->snippets->[0];
121 See also L<Catalyst::Manual::Intro>
125 The key concept of Catalyst is DRY (Don't Repeat Yourself).
127 See L<Catalyst::Manual> for more documentation.
129 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
130 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
131 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
133 use Catalyst 'My::Module';
135 Special flags like -Debug and -Engine can also be specified as arguments when
138 use Catalyst qw/-Debug My::Module/;
140 The position of plugins and flags in the chain is important, because they are
141 loaded in exactly the order that they appear.
143 The following flags are supported:
149 enables debug output, i.e.:
151 use Catalyst '-Debug';
153 this is equivalent to:
160 Force Catalyst to use a specific dispatcher.
164 Force Catalyst to use a specific engine.
165 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
167 use Catalyst '-Engine=CGI';
171 Force Catalyst to use a specific home directory.
185 Accessor for the current action
187 =item $c->comp($name)
189 =item $c->component($name)
191 Get a component object by name.
193 $c->comp('MyApp::Model::MyModel')->do_stuff;
204 my $appclass = ref $c || $c;
207 $name, "${appclass}::${name}",
208 map { "${appclass}::${_}::${name}" } qw/M V C/
211 foreach my $try (@names) {
213 if ( exists $c->components->{$try} ) {
215 return $c->components->{$try};
219 foreach my $component ( keys %{ $c->components } ) {
221 return $c->components->{$component} if $component =~ /$name/i;
226 return sort keys %{ $c->components };
231 Returns a hashref containing your applications settings.
235 =item $c->controller($name)
237 Get a L<Catalyst::Controller> instance by name.
239 $c->controller('Foo')->do_stuff;
244 my ( $c, $name ) = @_;
245 my $controller = $c->comp("Controller::$name");
246 return $controller if $controller;
247 return $c->comp("C::$name");
252 Overload to enable debug messages.
258 =item $c->detach( $command [, \@arguments ] )
260 Like C<forward> but doesn't return.
264 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
268 Contains the dispatcher instance.
269 Stringifies to class.
271 =item $c->forward( $command [, \@arguments ] )
273 Forward processing to a private action or a method from a class.
274 If you define a class without method it will default to process().
275 also takes an optional arrayref containing arguments to be passed
276 to the new function. $c->req->args will be reset upon returning
280 $c->forward('index');
281 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
282 $c->forward('MyApp::View::TT');
286 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
288 =item $c->model($name)
290 Get a L<Catalyst::Model> instance by name.
292 $c->model('Foo')->do_stuff;
297 my ( $c, $name ) = @_;
298 my $model = $c->comp("Model::$name");
299 return $model if $model;
300 return $c->comp("M::$name");
305 Accessor to the namespace of the current action
307 =item $c->path_to(@path)
309 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
313 $c->path_to( 'db', 'sqlite.db' );
318 my ( $c, @path ) = @_;
319 my $path = dir( $c->config->{home}, @path );
320 if ( -d $path ) { return $path }
321 else { return file( $c->config->{home}, @path ) }
333 my ( $class, @arguments ) = @_;
335 unless ( $class->isa('Catalyst') ) {
337 Catalyst::Exception->throw(
338 message => qq/'$class' does not inherit from Catalyst/ );
341 if ( $class->arguments ) {
342 @arguments = ( @arguments, @{ $class->arguments } );
348 foreach (@arguments) {
352 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
354 elsif (/^-(\w+)=?(.*)$/) {
355 $flags->{ lc $1 } = $2;
358 push @{ $flags->{plugins} }, $_;
362 $class->setup_log( delete $flags->{log} );
363 $class->setup_plugins( delete $flags->{plugins} );
364 $class->setup_dispatcher( delete $flags->{dispatcher} );
365 $class->setup_engine( delete $flags->{engine} );
366 $class->setup_home( delete $flags->{home} );
368 for my $flag ( sort keys %{$flags} ) {
370 if ( my $code = $class->can( 'setup_' . $flag ) ) {
371 &$code( $class, delete $flags->{$flag} );
374 $class->log->warn(qq/Unknown flag "$flag"/);
378 $class->log->warn( "You are running an old helper script! "
379 . "Please update your scripts by regenerating the "
380 . "application and copying over the new scripts." )
381 if ( $ENV{CATALYST_SCRIPT_GEN}
382 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
384 if ( $class->debug ) {
390 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
394 my $t = Text::SimpleTable->new(76);
395 $t->row($_) for @plugins;
396 $class->log->debug( "Loaded plugins:\n" . $t->draw );
399 my $dispatcher = $class->dispatcher;
400 my $engine = $class->engine;
401 my $home = $class->config->{home};
403 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
404 $class->log->debug(qq/Loaded engine "$engine"/);
408 ? $class->log->debug(qq/Found home "$home"/)
409 : $class->log->debug(qq/Home "$home" doesn't exist/)
410 : $class->log->debug(q/Couldn't find home/);
415 no warnings qw/redefine/;
416 local *setup = sub { };
420 # Initialize our data structure
421 $class->components( {} );
423 $class->setup_components;
425 if ( $class->debug ) {
426 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
427 for my $comp ( sort keys %{ $class->components } ) {
428 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
429 $t->row( $comp, $type );
431 $class->log->debug( "Loaded components:\n" . $t->draw )
432 if ( keys %{ $class->components } );
435 # Add our self to components, since we are also a component
436 $class->components->{$class} = $class;
438 $class->setup_actions;
440 if ( $class->debug ) {
441 my $name = $class->config->{name} || 'Application';
442 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
444 $class->log->_flush() if $class->log->can('_flush');
447 =item $c->uri_for($path,[@args])
449 Merges path with $c->request->base for absolute uri's and with
450 $c->request->match for relative uri's, then returns a normalized
451 L<URI> object. If any args are passed, they are added at the end
457 my ( $c, $path, @args ) = @_;
458 my $base = $c->request->base->clone;
459 my $basepath = $base->path;
460 $basepath =~ s/\/$//;
462 my $match = $c->request->match;
464 # massage match, empty if absolute path
466 $match .= '/' if $match;
468 $match = '' if $path =~ /^\//;
471 # join args with '/', or a blank string
472 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
473 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
479 =item $c->error($error, ...)
481 =item $c->error($arrayref)
483 Returns an arrayref containing error messages.
485 my @error = @{ $c->error };
489 $c->error('Something bad happened');
500 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
501 push @{ $c->{error} }, @$error;
503 elsif ( defined $_[0] ) { $c->{error} = undef }
504 return $c->{error} || [];
509 Contains the engine instance.
510 Stringifies to the class.
514 Contains the logging object. Unless it is already set Catalyst sets this up with a
515 C<Catalyst::Log> object. To use your own log class:
517 $c->log( MyLogger->new );
518 $c->log->info("now logging with my own logger!");
520 Your log class should implement the methods described in the C<Catalyst::Log>
523 =item $c->plugin( $name, $class, @args )
525 Instant plugins for Catalyst.
526 Classdata accessor/mutator will be created, class loaded and instantiated.
528 MyApp->plugin( 'prototype', 'HTML::Prototype' );
530 $c->prototype->define_javascript_functions;
535 my ( $class, $name, $plugin, @args ) = @_;
538 if ( my $error = $UNIVERSAL::require::ERROR ) {
539 Catalyst::Exception->throw(
540 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
543 eval { $plugin->import };
544 $class->mk_classdata($name);
546 eval { $obj = $plugin->new(@args) };
549 Catalyst::Exception->throw( message =>
550 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
554 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
562 Returns a C<Catalyst::Request> object.
570 Returns a C<Catalyst::Response> object.
576 Contains the return value of the last executed action.
580 Returns a hashref containing all your data.
582 print $c->stash->{foo};
584 Keys may be set in the stash by assigning to the hash reference, or by passing
585 either a single hash reference or a list of key/value pairs as arguments.
589 $c->stash->{foo} ||= 'yada';
590 $c->stash( { moose => 'majestic', qux => 0 } );
591 $c->stash( bar => 1, gorch => 2 );
598 my $stash = @_ > 1 ? {@_} : $_[0];
599 while ( my ( $key, $val ) = each %$stash ) {
600 $c->{stash}->{$key} = $val;
606 =item $c->view($name)
608 Get a L<Catalyst::View> instance by name.
610 $c->view('Foo')->do_stuff;
615 my ( $c, $name ) = @_;
616 my $view = $c->comp("View::$name");
617 return $view if $view;
618 return $c->comp("V::$name");
621 =item $c->welcome_message
623 Returns the Catalyst welcome HTML page.
627 sub welcome_message {
629 my $name = $c->config->{name};
630 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
631 my $prefix = Catalyst::Utils::appprefix( ref $c );
632 $c->response->content_type('text/html; charset=utf-8');
634 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
635 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
636 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
638 <meta http-equiv="Content-Language" content="en" />
639 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
640 <title>$name on Catalyst $VERSION</title>
641 <style type="text/css">
644 background-color: #eee;
653 background-color: #ccc;
654 border: 1px solid #aaa;
655 -moz-border-radius: 10px;
660 font-family: verdana, tahoma, sans-serif;
663 font-family: verdana, tahoma, sans-serif;
666 text-decoration: none;
668 border-bottom: 1px dotted #bbb;
670 :link:hover, :visited:hover {
683 background-color: #fff;
684 border: 1px solid #aaa;
685 -moz-border-radius: 10px;
711 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
716 <img src="$logo" alt="Catalyst Logo" />
718 <p>Welcome to the wonderful world of Catalyst.
719 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
720 framework will make web development something you had
721 never expected it to be: Fun, rewarding and quick.</p>
722 <h2>What to do now?</h2>
723 <p>That really depends on what <b>you</b> want to do.
724 We do, however, provide you with a few starting points.</p>
725 <p>If you want to jump right into web development with Catalyst
726 you might want to check out the documentation.</p>
727 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
728 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
729 <h2>What to do next?</h2>
730 <p>Next it's time to write an actual application. Use the
731 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
732 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
733 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
734 they can save you a lot of work.</p>
735 <pre><code>script/${prefix}_create.pl -help</code></pre>
736 <p>Also, be sure to check out the vast and growing
737 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
738 you are likely to find what you need there.
742 <p>Catalyst has a very active community. Here are the main places to
743 get in touch with us.</p>
746 <a href="http://dev.catalyst.perl.org">Wiki</a>
749 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
752 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
755 <h2>In conclusion</h2>
756 <p>The Catalyst team hopes you will enjoy using Catalyst as much
757 as we enjoyed making it. Please contact us if you have ideas
758 for improvement or other feedback.</p>
768 =head1 INTERNAL METHODS
772 =item $c->benchmark($coderef)
774 Takes a coderef with arguments and returns elapsed time as float.
776 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
777 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
784 my $time = [gettimeofday];
785 my @return = &$code(@_);
786 my $elapsed = tv_interval $time;
787 return wantarray ? ( $elapsed, @return ) : $elapsed;
792 Contains the components.
794 =item $c->context_class($class)
796 Contains the context class.
800 Returns a hashref containing coderefs and execution counts.
801 (Needed for deep recursion detection)
805 Returns the actual forward depth.
809 Dispatch request to actions.
813 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
815 =item $c->dispatcher_class($class)
817 Contains the dispatcher class.
821 Returns a list of 2-element array references (name, structure) pairs that will
822 be dumped on the error page in debug mode.
828 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
831 =item $c->engine_class($class)
833 Contains the engine class.
835 =item $c->execute($class, $coderef)
837 Execute a coderef in given class and catch exceptions.
838 Errors are available via $c->error.
843 my ( $c, $class, $code ) = @_;
844 $class = $c->components->{$class} || $class;
848 ( caller(0) )[0]->isa('Catalyst::Action')
855 $action = "/$action" unless $action =~ /\-\>/;
856 $c->counter->{"$code"}++;
858 if ( $c->counter->{"$code"} > $RECURSION ) {
859 my $error = qq/Deep recursion detected in "$action"/;
860 $c->log->error($error);
866 $action = "-> $action" if $callsub =~ /forward$/;
868 push( @{ $c->stack }, $code );
872 my ( $elapsed, @state ) =
873 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
874 unless ( ( $code->name =~ /^_.*/ )
875 && ( !$c->config->{show_internal_actions} ) )
877 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
882 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
885 pop( @{ $c->stack } );
887 if ( my $error = $@ ) {
889 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
891 unless ( ref $error ) {
893 $error = qq/Caught exception "$error"/;
911 for my $error ( @{ $c->error } ) {
912 $c->log->error($error);
915 $c->finalize_uploads;
918 if ( $#{ $c->error } >= 0 ) {
922 $c->finalize_headers;
925 if ( $c->request->method eq 'HEAD' ) {
926 $c->response->body('');
931 return $c->response->status;
934 =item $c->finalize_body
940 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
942 =item $c->finalize_cookies
948 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
950 =item $c->finalize_error
956 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
958 =item $c->finalize_headers
964 sub finalize_headers {
967 # Check if we already finalized headers
968 return if $c->response->{_finalized_headers};
971 if ( my $location = $c->response->redirect ) {
972 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
973 $c->response->header( Location => $location );
977 if ( $c->response->body && !$c->response->content_length ) {
978 $c->response->content_length( bytes::length( $c->response->body ) );
982 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
983 $c->response->headers->remove_header("Content-Length");
984 $c->response->body('');
987 $c->finalize_cookies;
989 $c->engine->finalize_headers( $c, @_ );
992 $c->response->{_finalized_headers} = 1;
995 =item $c->finalize_output
997 An alias for finalize_body.
999 =item $c->finalize_read
1001 Finalize the input after reading is complete.
1005 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1007 =item $c->finalize_uploads
1009 Finalize uploads. Cleans up any temporary files.
1013 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1015 =item $c->get_action( $action, $namespace )
1017 Get an action in a given namespace.
1021 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1023 =item $c->get_actions( $action, $namespace )
1025 Get all actions of a given name in a namespace and all base namespaces.
1029 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1031 =item handle_request( $class, @arguments )
1033 Handles the request.
1037 sub handle_request {
1038 my ( $class, @arguments ) = @_;
1040 # Always expect worst case!
1046 my $c = $class->prepare(@arguments);
1047 $c->{stats} = \@stats;
1049 return $c->finalize;
1052 if ( $class->debug ) {
1054 ( $elapsed, $status ) = $class->benchmark($handler);
1055 $elapsed = sprintf '%f', $elapsed;
1056 my $av = sprintf '%.3f',
1057 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1058 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1060 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1062 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1064 else { $status = &$handler }
1068 if ( my $error = $@ ) {
1070 $class->log->error(qq/Caught exception in engine "$error"/);
1074 $class->log->_flush() if $class->log->can('_flush');
1078 =item $c->prepare(@arguments)
1080 Turns the engine-specific request( Apache, CGI ... )
1081 into a Catalyst context .
1086 my ( $class, @arguments ) = @_;
1088 $class->context_class( ref $class || $class ) unless $class->context_class;
1089 my $c = $class->context_class->new(
1093 request => $class->request_class->new(
1096 body_parameters => {},
1098 headers => HTTP::Headers->new,
1100 query_parameters => {},
1106 response => $class->response_class->new(
1110 headers => HTTP::Headers->new(),
1119 # For on-demand data
1120 $c->request->{_context} = $c;
1121 $c->response->{_context} = $c;
1122 weaken( $c->request->{_context} );
1123 weaken( $c->response->{_context} );
1126 my $secs = time - $START || 1;
1127 my $av = sprintf '%.3f', $COUNT / $secs;
1128 $c->log->debug('**********************************');
1129 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1130 $c->log->debug('**********************************');
1131 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1134 $c->prepare_request(@arguments);
1135 $c->prepare_connection;
1136 $c->prepare_query_parameters;
1137 $c->prepare_headers;
1138 $c->prepare_cookies;
1142 $c->prepare_body unless $c->config->{parse_on_demand};
1145 my $method = $c->req->method || '';
1146 my $path = $c->req->path || '';
1147 my $address = $c->req->address || '';
1149 $c->log->debug(qq/"$method" request for "$path" from $address/)
1155 =item $c->prepare_action
1161 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1163 =item $c->prepare_body
1165 Prepare message body.
1172 # Do we run for the first time?
1173 return if defined $c->request->{_body};
1175 # Initialize on-demand data
1176 $c->engine->prepare_body( $c, @_ );
1177 $c->prepare_parameters;
1178 $c->prepare_uploads;
1180 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1181 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1182 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1183 my $param = $c->req->body_parameters->{$key};
1184 my $value = defined($param) ? $param : '';
1186 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1188 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1192 =item $c->prepare_body_chunk( $chunk )
1194 Prepare a chunk of data before sending it to HTTP::Body.
1198 sub prepare_body_chunk {
1200 $c->engine->prepare_body_chunk( $c, @_ );
1203 =item $c->prepare_body_parameters
1205 Prepare body parameters.
1209 sub prepare_body_parameters {
1211 $c->engine->prepare_body_parameters( $c, @_ );
1214 =item $c->prepare_connection
1220 sub prepare_connection {
1222 $c->engine->prepare_connection( $c, @_ );
1225 =item $c->prepare_cookies
1231 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1233 =item $c->prepare_headers
1239 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1241 =item $c->prepare_parameters
1247 sub prepare_parameters {
1249 $c->prepare_body_parameters;
1250 $c->engine->prepare_parameters( $c, @_ );
1253 =item $c->prepare_path
1255 Prepare path and base.
1259 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1261 =item $c->prepare_query_parameters
1263 Prepare query parameters.
1267 sub prepare_query_parameters {
1270 $c->engine->prepare_query_parameters( $c, @_ );
1272 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1273 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1274 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1275 my $param = $c->req->query_parameters->{$key};
1276 my $value = defined($param) ? $param : '';
1278 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1280 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1284 =item $c->prepare_read
1286 Prepare the input for reading.
1290 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1292 =item $c->prepare_request
1294 Prepare the engine request.
1298 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1300 =item $c->prepare_uploads
1306 sub prepare_uploads {
1309 $c->engine->prepare_uploads( $c, @_ );
1311 if ( $c->debug && keys %{ $c->request->uploads } ) {
1312 my $t = Text::SimpleTable->new(
1318 for my $key ( sort keys %{ $c->request->uploads } ) {
1319 my $upload = $c->request->uploads->{$key};
1320 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1321 $t->row( $key, $u->filename, $u->type, $u->size );
1324 $c->log->debug( "File Uploads are:\n" . $t->draw );
1328 =item $c->prepare_write
1330 Prepare the output for writing.
1334 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1336 =item $c->request_class($class)
1338 Contains the request class.
1340 =item $c->response_class($class)
1342 Contains the response class.
1344 =item $c->read( [$maxlength] )
1346 Read a chunk of data from the request body. This method is designed to be
1347 used in a while loop, reading $maxlength bytes on every call. $maxlength
1348 defaults to the size of the request if not specified.
1350 You have to set MyApp->config->{parse_on_demand} to use this directly.
1354 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1362 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1364 =item $c->set_action( $action, $code, $namespace, $attrs )
1366 Set an action in a given namespace.
1370 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1372 =item $c->setup_actions($component)
1374 Setup actions for a component.
1378 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1380 =item $c->setup_components
1386 sub setup_components {
1389 my $callback = sub {
1390 my ( $component, $context ) = @_;
1392 unless ( $component->isa('Catalyst::Component') ) {
1396 my $suffix = Catalyst::Utils::class2classsuffix($class);
1397 my $config = $class->config->{$suffix} || {};
1401 eval { $instance = $component->new( $context, $config ); };
1403 if ( my $error = $@ ) {
1407 Catalyst::Exception->throw( message =>
1408 qq/Couldn't instantiate component "$component", "$error"/ );
1411 Catalyst::Exception->throw( message =>
1412 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1414 unless ref $instance;
1419 Module::Pluggable::Fast->import(
1420 name => '_catalyst_components',
1422 "$class\::Controller", "$class\::C",
1423 "$class\::Model", "$class\::M",
1424 "$class\::View", "$class\::V"
1426 callback => $callback
1430 if ( my $error = $@ ) {
1434 Catalyst::Exception->throw(
1435 message => qq/Couldn't load components "$error"/ );
1438 for my $component ( $class->_catalyst_components($class) ) {
1439 $class->components->{ ref $component || $component } = $component;
1443 =item $c->setup_dispatcher
1447 sub setup_dispatcher {
1448 my ( $class, $dispatcher ) = @_;
1451 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1454 if ( $ENV{CATALYST_DISPATCHER} ) {
1455 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1458 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1460 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1463 unless ($dispatcher) {
1464 $dispatcher = $class->dispatcher_class;
1467 $dispatcher->require;
1470 Catalyst::Exception->throw(
1471 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1474 # dispatcher instance
1475 $class->dispatcher( $dispatcher->new );
1478 =item $c->setup_engine
1483 my ( $class, $engine ) = @_;
1486 $engine = 'Catalyst::Engine::' . $engine;
1489 if ( $ENV{CATALYST_ENGINE} ) {
1490 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1493 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1494 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1497 if ( !$engine && $ENV{MOD_PERL} ) {
1499 # create the apache method
1502 *{"$class\::apache"} = sub { shift->engine->apache };
1505 my ( $software, $version ) =
1506 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1509 $version =~ s/(\.[^.]+)\./$1/g;
1511 if ( $software eq 'mod_perl' ) {
1513 if ( $version >= 1.99922 ) {
1514 $engine = 'Catalyst::Engine::Apache2::MP20';
1517 elsif ( $version >= 1.9901 ) {
1518 $engine = 'Catalyst::Engine::Apache2::MP19';
1521 elsif ( $version >= 1.24 ) {
1522 $engine = 'Catalyst::Engine::Apache::MP13';
1526 Catalyst::Exception->throw( message =>
1527 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1530 # install the correct mod_perl handler
1531 if ( $version >= 1.9901 ) {
1532 *handler = sub : method {
1533 shift->handle_request(@_);
1537 *handler = sub ($$) { shift->handle_request(@_) };
1542 elsif ( $software eq 'Zeus-Perl' ) {
1543 $engine = 'Catalyst::Engine::Zeus';
1547 Catalyst::Exception->throw(
1548 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1553 $engine = $class->engine_class;
1559 Catalyst::Exception->throw( message =>
1560 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1564 # check for old engines that are no longer compatible
1566 if ( $engine->isa('Catalyst::Engine::Apache')
1567 && !Catalyst::Engine::Apache->VERSION )
1572 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1573 && Catalyst::Engine::Server->VERSION le '0.02' )
1578 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1579 && $engine->VERSION eq '0.01' )
1584 elsif ($engine->isa('Catalyst::Engine::Zeus')
1585 && $engine->VERSION eq '0.01' )
1591 Catalyst::Exception->throw( message =>
1592 qq/Engine "$engine" is not supported by this version of Catalyst/
1597 $class->engine( $engine->new );
1600 =item $c->setup_home
1605 my ( $class, $home ) = @_;
1607 if ( $ENV{CATALYST_HOME} ) {
1608 $home = $ENV{CATALYST_HOME};
1611 if ( $ENV{ uc($class) . '_HOME' } ) {
1612 $home = $ENV{ uc($class) . '_HOME' };
1616 $home = Catalyst::Utils::home($class);
1620 $class->config->{home} ||= $home;
1621 $class->config->{root} ||= dir($home)->subdir('root');
1630 my ( $class, $debug ) = @_;
1632 unless ( $class->log ) {
1633 $class->log( Catalyst::Log->new );
1636 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1639 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1640 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1645 *{"$class\::debug"} = sub { 1 };
1646 $class->log->debug('Debug messages enabled');
1650 =item $c->setup_plugins
1655 my ( $class, $plugins ) = @_;
1658 for my $plugin ( reverse @$plugins ) {
1660 $plugin = "Catalyst::Plugin::$plugin";
1665 Catalyst::Exception->throw(
1666 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1671 unshift @{"$class\::ISA"}, $plugin;
1680 =item $c->write( $data )
1682 Writes $data to the output stream. When using this method directly, you will
1683 need to manually set the Content-Length header to the length of your output
1691 # Finalize headers if someone manually writes output
1692 $c->finalize_headers;
1694 return $c->engine->write( $c, @_ );
1699 Returns the Catalyst version number. mostly useful for powered by messages
1700 in template systems.
1704 sub version { return $Catalyst::VERSION }
1708 =head1 INTERNAL ACTIONS
1710 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1711 C<_ACTION> and C<_END>, these are by default not shown in the private
1714 But you can deactivate this with a config parameter.
1716 MyApp->config->{show_internal_actions} = 1;
1718 =head1 CASE SENSITIVITY
1720 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1723 But you can activate case sensitivity with a config parameter.
1725 MyApp->config->{case_sensitive} = 1;
1727 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1729 =head1 ON-DEMAND PARSER
1731 The request body is usually parsed at the beginning of a request,
1732 but if you want to handle input yourself or speed things up a bit
1733 you can enable on-demand parsing with a config parameter.
1735 MyApp->config->{parse_on_demand} = 1;
1737 =head1 PROXY SUPPORT
1739 Many production servers operate using the common double-server approach, with
1740 a lightweight frontend web server passing requests to a larger backend
1741 server. An application running on the backend server must deal with two
1742 problems: the remote user always appears to be '127.0.0.1' and the server's
1743 hostname will appear to be 'localhost' regardless of the virtual host the
1744 user connected through.
1746 Catalyst will automatically detect this situation when you are running both
1747 the frontend and backend servers on the same machine. The following changes
1748 are made to the request.
1750 $c->req->address is set to the user's real IP address, as read from the
1751 HTTP_X_FORWARDED_FOR header.
1753 The host value for $c->req->base and $c->req->uri is set to the real host,
1754 as read from the HTTP_X_FORWARDED_HOST header.
1756 Obviously, your web server must support these 2 headers for this to work.
1758 In a more complex server farm environment where you may have your frontend
1759 proxy server(s) on different machines, you will need to set a configuration
1760 option to tell Catalyst to read the proxied data from the headers.
1762 MyApp->config->{using_frontend_proxy} = 1;
1764 If you do not wish to use the proxy support at all, you may set:
1766 MyApp->config->{ignore_frontend_proxy} = 1;
1768 =head1 THREAD SAFETY
1770 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1771 and the standalone forking HTTP server on Windows. We believe the Catalyst
1772 core to be thread-safe.
1774 If you plan to operate in a threaded environment, remember that all other
1775 modules you are using must also be thread-safe. Some modules, most notably
1776 DBD::SQLite, are not thread-safe.
1782 Join #catalyst on irc.perl.org.
1786 http://lists.rawmode.org/mailman/listinfo/catalyst
1787 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1791 http://catalyst.perl.org
1797 =item L<Catalyst::Manual> - The Catalyst Manual
1799 =item L<Catalyst::Engine> - Core Engine
1801 =item L<Catalyst::Log> - The Log Class.
1803 =item L<Catalyst::Request> - The Request Object
1805 =item L<Catalyst::Response> - The Response Object
1807 =item L<Catalyst::Test> - The test suite.
1875 Sebastian Riedel, C<sri@oook.de>
1879 This library is free software, you can redistribute it and/or modify it under
1880 the same terms as Perl itself.