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 = 11;
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"/);
379 <<"EOF") if ( $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
380 You are running an old script!
382 Please update by running:
383 catalyst.pl -nonew -scripts $class
386 if ( $class->debug ) {
392 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
396 my $t = Text::SimpleTable->new(76);
397 $t->row($_) for @plugins;
398 $class->log->debug( "Loaded plugins:\n" . $t->draw );
401 my $dispatcher = $class->dispatcher;
402 my $engine = $class->engine;
403 my $home = $class->config->{home};
405 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
406 $class->log->debug(qq/Loaded engine "$engine"/);
410 ? $class->log->debug(qq/Found home "$home"/)
411 : $class->log->debug(qq/Home "$home" doesn't exist/)
412 : $class->log->debug(q/Couldn't find home/);
417 no warnings qw/redefine/;
418 local *setup = sub { };
422 # Initialize our data structure
423 $class->components( {} );
425 $class->setup_components;
427 if ( $class->debug ) {
428 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
429 for my $comp ( sort keys %{ $class->components } ) {
430 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
431 $t->row( $comp, $type );
433 $class->log->debug( "Loaded components:\n" . $t->draw )
434 if ( keys %{ $class->components } );
437 # Add our self to components, since we are also a component
438 $class->components->{$class} = $class;
440 $class->setup_actions;
442 if ( $class->debug ) {
443 my $name = $class->config->{name} || 'Application';
444 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
446 $class->log->_flush() if $class->log->can('_flush');
449 =item $c->uri_for($path,[@args])
451 Merges path with $c->request->base for absolute uri's and with
452 $c->request->match for relative uri's, then returns a normalized
453 L<URI> object. If any args are passed, they are added at the end
459 my ( $c, $path, @args ) = @_;
460 my $base = $c->request->base->clone;
461 my $basepath = $base->path;
462 $basepath =~ s/\/$//;
464 my $match = $c->request->match;
466 # massage match, empty if absolute path
468 $match .= '/' if $match;
470 $match = '' if $path =~ /^\//;
473 # join args with '/', or a blank string
474 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
475 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
481 =item $c->error($error, ...)
483 =item $c->error($arrayref)
485 Returns an arrayref containing error messages.
487 my @error = @{ $c->error };
491 $c->error('Something bad happened');
502 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
503 push @{ $c->{error} }, @$error;
505 elsif ( defined $_[0] ) { $c->{error} = undef }
506 return $c->{error} || [];
511 Contains the engine instance.
512 Stringifies to the class.
516 Contains the logging object. Unless it is already set Catalyst sets this up with a
517 C<Catalyst::Log> object. To use your own log class:
519 $c->log( MyLogger->new );
520 $c->log->info("now logging with my own logger!");
522 Your log class should implement the methods described in the C<Catalyst::Log>
525 =item $c->plugin( $name, $class, @args )
527 Instant plugins for Catalyst.
528 Classdata accessor/mutator will be created, class loaded and instantiated.
530 MyApp->plugin( 'prototype', 'HTML::Prototype' );
532 $c->prototype->define_javascript_functions;
537 my ( $class, $name, $plugin, @args ) = @_;
540 if ( my $error = $UNIVERSAL::require::ERROR ) {
541 Catalyst::Exception->throw(
542 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
545 eval { $plugin->import };
546 $class->mk_classdata($name);
548 eval { $obj = $plugin->new(@args) };
551 Catalyst::Exception->throw( message =>
552 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
556 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
564 Returns a C<Catalyst::Request> object.
572 Returns a C<Catalyst::Response> object.
578 Contains the return value of the last executed action.
582 Returns a hashref containing all your data.
584 print $c->stash->{foo};
586 Keys may be set in the stash by assigning to the hash reference, or by passing
587 either a single hash reference or a list of key/value pairs as arguments.
591 $c->stash->{foo} ||= 'yada';
592 $c->stash( { moose => 'majestic', qux => 0 } );
593 $c->stash( bar => 1, gorch => 2 );
600 my $stash = @_ > 1 ? {@_} : $_[0];
601 while ( my ( $key, $val ) = each %$stash ) {
602 $c->{stash}->{$key} = $val;
608 =item $c->view($name)
610 Get a L<Catalyst::View> instance by name.
612 $c->view('Foo')->do_stuff;
617 my ( $c, $name ) = @_;
618 my $view = $c->comp("View::$name");
619 return $view if $view;
620 return $c->comp("V::$name");
623 =item $c->welcome_message
625 Returns the Catalyst welcome HTML page.
629 sub welcome_message {
631 my $name = $c->config->{name};
632 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
633 my $prefix = Catalyst::Utils::appprefix( ref $c );
634 $c->response->content_type('text/html; charset=utf-8');
636 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
637 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
638 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
640 <meta http-equiv="Content-Language" content="en" />
641 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
642 <title>$name on Catalyst $VERSION</title>
643 <style type="text/css">
646 background-color: #eee;
655 background-color: #ccc;
656 border: 1px solid #aaa;
657 -moz-border-radius: 10px;
662 font-family: verdana, tahoma, sans-serif;
665 font-family: verdana, tahoma, sans-serif;
668 text-decoration: none;
670 border-bottom: 1px dotted #bbb;
672 :link:hover, :visited:hover {
685 background-color: #fff;
686 border: 1px solid #aaa;
687 -moz-border-radius: 10px;
713 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
718 <img src="$logo" alt="Catalyst Logo" />
720 <p>Welcome to the wonderful world of Catalyst.
721 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
722 framework will make web development something you had
723 never expected it to be: Fun, rewarding and quick.</p>
724 <h2>What to do now?</h2>
725 <p>That really depends on what <b>you</b> want to do.
726 We do, however, provide you with a few starting points.</p>
727 <p>If you want to jump right into web development with Catalyst
728 you might want to check out the documentation.</p>
729 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
730 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
731 <h2>What to do next?</h2>
732 <p>Next it's time to write an actual application. Use the
733 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
734 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
735 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
736 they can save you a lot of work.</p>
737 <pre><code>script/${prefix}_create.pl -help</code></pre>
738 <p>Also, be sure to check out the vast and growing
739 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
740 you are likely to find what you need there.
744 <p>Catalyst has a very active community. Here are the main places to
745 get in touch with us.</p>
748 <a href="http://dev.catalyst.perl.org">Wiki</a>
751 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
754 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
757 <h2>In conclusion</h2>
758 <p>The Catalyst team hopes you will enjoy using Catalyst as much
759 as we enjoyed making it. Please contact us if you have ideas
760 for improvement or other feedback.</p>
770 =head1 INTERNAL METHODS
774 =item $c->benchmark($coderef)
776 Takes a coderef with arguments and returns elapsed time as float.
778 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
779 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
786 my $time = [gettimeofday];
787 my @return = &$code(@_);
788 my $elapsed = tv_interval $time;
789 return wantarray ? ( $elapsed, @return ) : $elapsed;
794 Contains the components.
796 =item $c->context_class($class)
798 Contains the context class.
802 Returns a hashref containing coderefs and execution counts.
803 (Needed for deep recursion detection)
807 Returns the actual forward depth.
811 Dispatch request to actions.
815 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
817 =item $c->dispatcher_class($class)
819 Contains the dispatcher class.
823 Returns a list of 2-element array references (name, structure) pairs that will
824 be dumped on the error page in debug mode.
830 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
833 =item $c->engine_class($class)
835 Contains the engine class.
837 =item $c->execute($class, $coderef)
839 Execute a coderef in given class and catch exceptions.
840 Errors are available via $c->error.
845 my ( $c, $class, $code ) = @_;
846 $class = $c->components->{$class} || $class;
850 ( caller(0) )[0]->isa('Catalyst::Action')
857 $action = "/$action" unless $action =~ /\-\>/;
858 $c->counter->{"$code"}++;
860 if ( $c->counter->{"$code"} > $RECURSION ) {
861 my $error = qq/Deep recursion detected in "$action"/;
862 $c->log->error($error);
868 $action = "-> $action" if $callsub =~ /forward$/;
870 push( @{ $c->stack }, $code );
874 my ( $elapsed, @state ) =
875 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
876 unless ( ( $code->name =~ /^_.*/ )
877 && ( !$c->config->{show_internal_actions} ) )
879 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
884 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
887 pop( @{ $c->stack } );
889 if ( my $error = $@ ) {
891 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
893 unless ( ref $error ) {
895 $error = qq/Caught exception "$error"/;
913 for my $error ( @{ $c->error } ) {
914 $c->log->error($error);
917 $c->finalize_uploads;
920 if ( $#{ $c->error } >= 0 ) {
924 $c->finalize_headers;
927 if ( $c->request->method eq 'HEAD' ) {
928 $c->response->body('');
933 return $c->response->status;
936 =item $c->finalize_body
942 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
944 =item $c->finalize_cookies
950 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
952 =item $c->finalize_error
958 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
960 =item $c->finalize_headers
966 sub finalize_headers {
969 # Check if we already finalized headers
970 return if $c->response->{_finalized_headers};
973 if ( my $location = $c->response->redirect ) {
974 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
975 $c->response->header( Location => $location );
979 if ( $c->response->body && !$c->response->content_length ) {
980 $c->response->content_length( bytes::length( $c->response->body ) );
984 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
985 $c->response->headers->remove_header("Content-Length");
986 $c->response->body('');
989 $c->finalize_cookies;
991 $c->engine->finalize_headers( $c, @_ );
994 $c->response->{_finalized_headers} = 1;
997 =item $c->finalize_output
999 An alias for finalize_body.
1001 =item $c->finalize_read
1003 Finalize the input after reading is complete.
1007 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1009 =item $c->finalize_uploads
1011 Finalize uploads. Cleans up any temporary files.
1015 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1017 =item $c->get_action( $action, $namespace )
1019 Get an action in a given namespace.
1023 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1025 =item $c->get_actions( $action, $namespace )
1027 Get all actions of a given name in a namespace and all base namespaces.
1031 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1033 =item handle_request( $class, @arguments )
1035 Handles the request.
1039 sub handle_request {
1040 my ( $class, @arguments ) = @_;
1042 # Always expect worst case!
1048 my $c = $class->prepare(@arguments);
1049 $c->{stats} = \@stats;
1051 return $c->finalize;
1054 if ( $class->debug ) {
1056 ( $elapsed, $status ) = $class->benchmark($handler);
1057 $elapsed = sprintf '%f', $elapsed;
1058 my $av = sprintf '%.3f',
1059 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1060 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1062 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1064 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1066 else { $status = &$handler }
1070 if ( my $error = $@ ) {
1072 $class->log->error(qq/Caught exception in engine "$error"/);
1076 $class->log->_flush() if $class->log->can('_flush');
1080 =item $c->prepare(@arguments)
1082 Turns the engine-specific request( Apache, CGI ... )
1083 into a Catalyst context .
1088 my ( $class, @arguments ) = @_;
1090 $class->context_class( ref $class || $class ) unless $class->context_class;
1091 my $c = $class->context_class->new(
1095 request => $class->request_class->new(
1098 body_parameters => {},
1100 headers => HTTP::Headers->new,
1102 query_parameters => {},
1108 response => $class->response_class->new(
1112 headers => HTTP::Headers->new(),
1121 # For on-demand data
1122 $c->request->{_context} = $c;
1123 $c->response->{_context} = $c;
1124 weaken( $c->request->{_context} );
1125 weaken( $c->response->{_context} );
1128 my $secs = time - $START || 1;
1129 my $av = sprintf '%.3f', $COUNT / $secs;
1130 $c->log->debug('**********************************');
1131 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1132 $c->log->debug('**********************************');
1133 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1136 $c->prepare_request(@arguments);
1137 $c->prepare_connection;
1138 $c->prepare_query_parameters;
1139 $c->prepare_headers;
1140 $c->prepare_cookies;
1144 $c->prepare_body unless $c->config->{parse_on_demand};
1147 my $method = $c->req->method || '';
1148 my $path = $c->req->path || '';
1149 my $address = $c->req->address || '';
1151 $c->log->debug(qq/"$method" request for "$path" from $address/)
1157 =item $c->prepare_action
1163 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1165 =item $c->prepare_body
1167 Prepare message body.
1174 # Do we run for the first time?
1175 return if defined $c->request->{_body};
1177 # Initialize on-demand data
1178 $c->engine->prepare_body( $c, @_ );
1179 $c->prepare_parameters;
1180 $c->prepare_uploads;
1182 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1183 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1184 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1185 my $param = $c->req->body_parameters->{$key};
1186 my $value = defined($param) ? $param : '';
1188 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1190 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1194 =item $c->prepare_body_chunk( $chunk )
1196 Prepare a chunk of data before sending it to HTTP::Body.
1200 sub prepare_body_chunk {
1202 $c->engine->prepare_body_chunk( $c, @_ );
1205 =item $c->prepare_body_parameters
1207 Prepare body parameters.
1211 sub prepare_body_parameters {
1213 $c->engine->prepare_body_parameters( $c, @_ );
1216 =item $c->prepare_connection
1222 sub prepare_connection {
1224 $c->engine->prepare_connection( $c, @_ );
1227 =item $c->prepare_cookies
1233 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1235 =item $c->prepare_headers
1241 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1243 =item $c->prepare_parameters
1249 sub prepare_parameters {
1251 $c->prepare_body_parameters;
1252 $c->engine->prepare_parameters( $c, @_ );
1255 =item $c->prepare_path
1257 Prepare path and base.
1261 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1263 =item $c->prepare_query_parameters
1265 Prepare query parameters.
1269 sub prepare_query_parameters {
1272 $c->engine->prepare_query_parameters( $c, @_ );
1274 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1275 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1276 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1277 my $param = $c->req->query_parameters->{$key};
1278 my $value = defined($param) ? $param : '';
1280 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1282 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1286 =item $c->prepare_read
1288 Prepare the input for reading.
1292 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1294 =item $c->prepare_request
1296 Prepare the engine request.
1300 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1302 =item $c->prepare_uploads
1308 sub prepare_uploads {
1311 $c->engine->prepare_uploads( $c, @_ );
1313 if ( $c->debug && keys %{ $c->request->uploads } ) {
1314 my $t = Text::SimpleTable->new(
1320 for my $key ( sort keys %{ $c->request->uploads } ) {
1321 my $upload = $c->request->uploads->{$key};
1322 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1323 $t->row( $key, $u->filename, $u->type, $u->size );
1326 $c->log->debug( "File Uploads are:\n" . $t->draw );
1330 =item $c->prepare_write
1332 Prepare the output for writing.
1336 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1338 =item $c->request_class($class)
1340 Contains the request class.
1342 =item $c->response_class($class)
1344 Contains the response class.
1346 =item $c->read( [$maxlength] )
1348 Read a chunk of data from the request body. This method is designed to be
1349 used in a while loop, reading $maxlength bytes on every call. $maxlength
1350 defaults to the size of the request if not specified.
1352 You have to set MyApp->config->{parse_on_demand} to use this directly.
1356 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1364 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1366 =item $c->set_action( $action, $code, $namespace, $attrs )
1368 Set an action in a given namespace.
1372 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1374 =item $c->setup_actions($component)
1376 Setup actions for a component.
1380 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1382 =item $c->setup_components
1388 sub setup_components {
1391 my $callback = sub {
1392 my ( $component, $context ) = @_;
1394 unless ( $component->isa('Catalyst::Component') ) {
1398 my $suffix = Catalyst::Utils::class2classsuffix($component);
1399 my $config = $class->config->{$suffix} || {};
1403 eval { $instance = $component->new( $context, $config ); };
1405 if ( my $error = $@ ) {
1409 Catalyst::Exception->throw( message =>
1410 qq/Couldn't instantiate component "$component", "$error"/ );
1413 Catalyst::Exception->throw( message =>
1414 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1416 unless ref $instance;
1421 Module::Pluggable::Fast->import(
1422 name => '_catalyst_components',
1424 "$class\::Controller", "$class\::C",
1425 "$class\::Model", "$class\::M",
1426 "$class\::View", "$class\::V"
1428 callback => $callback
1432 if ( my $error = $@ ) {
1436 Catalyst::Exception->throw(
1437 message => qq/Couldn't load components "$error"/ );
1440 for my $component ( $class->_catalyst_components($class) ) {
1441 $class->components->{ ref $component || $component } = $component;
1445 =item $c->setup_dispatcher
1449 sub setup_dispatcher {
1450 my ( $class, $dispatcher ) = @_;
1453 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1456 if ( $ENV{CATALYST_DISPATCHER} ) {
1457 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1460 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1462 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1465 unless ($dispatcher) {
1466 $dispatcher = $class->dispatcher_class;
1469 $dispatcher->require;
1472 Catalyst::Exception->throw(
1473 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1476 # dispatcher instance
1477 $class->dispatcher( $dispatcher->new );
1480 =item $c->setup_engine
1485 my ( $class, $engine ) = @_;
1488 $engine = 'Catalyst::Engine::' . $engine;
1491 if ( $ENV{CATALYST_ENGINE} ) {
1492 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1495 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1496 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1499 if ( !$engine && $ENV{MOD_PERL} ) {
1501 # create the apache method
1504 *{"$class\::apache"} = sub { shift->engine->apache };
1507 my ( $software, $version ) =
1508 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1511 $version =~ s/(\.[^.]+)\./$1/g;
1513 if ( $software eq 'mod_perl' ) {
1515 if ( $version >= 1.99922 ) {
1516 $engine = 'Catalyst::Engine::Apache2::MP20';
1519 elsif ( $version >= 1.9901 ) {
1520 $engine = 'Catalyst::Engine::Apache2::MP19';
1523 elsif ( $version >= 1.24 ) {
1524 $engine = 'Catalyst::Engine::Apache::MP13';
1528 Catalyst::Exception->throw( message =>
1529 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1532 # install the correct mod_perl handler
1533 if ( $version >= 1.9901 ) {
1534 *handler = sub : method {
1535 shift->handle_request(@_);
1539 *handler = sub ($$) { shift->handle_request(@_) };
1544 elsif ( $software eq 'Zeus-Perl' ) {
1545 $engine = 'Catalyst::Engine::Zeus';
1549 Catalyst::Exception->throw(
1550 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1555 $engine = $class->engine_class;
1561 Catalyst::Exception->throw( message =>
1562 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1566 # check for old engines that are no longer compatible
1568 if ( $engine->isa('Catalyst::Engine::Apache')
1569 && !Catalyst::Engine::Apache->VERSION )
1574 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1575 && Catalyst::Engine::Server->VERSION le '0.02' )
1580 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1581 && $engine->VERSION eq '0.01' )
1586 elsif ($engine->isa('Catalyst::Engine::Zeus')
1587 && $engine->VERSION eq '0.01' )
1593 Catalyst::Exception->throw( message =>
1594 qq/Engine "$engine" is not supported by this version of Catalyst/
1599 $class->engine( $engine->new );
1602 =item $c->setup_home
1607 my ( $class, $home ) = @_;
1609 if ( $ENV{CATALYST_HOME} ) {
1610 $home = $ENV{CATALYST_HOME};
1613 if ( $ENV{ uc($class) . '_HOME' } ) {
1614 $home = $ENV{ uc($class) . '_HOME' };
1618 $home = Catalyst::Utils::home($class);
1622 $class->config->{home} ||= $home;
1623 $class->config->{root} ||= dir($home)->subdir('root');
1632 my ( $class, $debug ) = @_;
1634 unless ( $class->log ) {
1635 $class->log( Catalyst::Log->new );
1638 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1641 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1642 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1647 *{"$class\::debug"} = sub { 1 };
1648 $class->log->debug('Debug messages enabled');
1652 =item $c->setup_plugins
1657 my ( $class, $plugins ) = @_;
1660 for my $plugin ( reverse @$plugins ) {
1662 $plugin = "Catalyst::Plugin::$plugin";
1667 Catalyst::Exception->throw(
1668 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1673 unshift @{"$class\::ISA"}, $plugin;
1682 =item $c->write( $data )
1684 Writes $data to the output stream. When using this method directly, you will
1685 need to manually set the Content-Length header to the length of your output
1693 # Finalize headers if someone manually writes output
1694 $c->finalize_headers;
1696 return $c->engine->write( $c, @_ );
1701 Returns the Catalyst version number. mostly useful for powered by messages
1702 in template systems.
1706 sub version { return $Catalyst::VERSION }
1710 =head1 INTERNAL ACTIONS
1712 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1713 C<_ACTION> and C<_END>, these are by default not shown in the private
1716 But you can deactivate this with a config parameter.
1718 MyApp->config->{show_internal_actions} = 1;
1720 =head1 CASE SENSITIVITY
1722 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1725 But you can activate case sensitivity with a config parameter.
1727 MyApp->config->{case_sensitive} = 1;
1729 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1731 =head1 ON-DEMAND PARSER
1733 The request body is usually parsed at the beginning of a request,
1734 but if you want to handle input yourself or speed things up a bit
1735 you can enable on-demand parsing with a config parameter.
1737 MyApp->config->{parse_on_demand} = 1;
1739 =head1 PROXY SUPPORT
1741 Many production servers operate using the common double-server approach, with
1742 a lightweight frontend web server passing requests to a larger backend
1743 server. An application running on the backend server must deal with two
1744 problems: the remote user always appears to be '127.0.0.1' and the server's
1745 hostname will appear to be 'localhost' regardless of the virtual host the
1746 user connected through.
1748 Catalyst will automatically detect this situation when you are running both
1749 the frontend and backend servers on the same machine. The following changes
1750 are made to the request.
1752 $c->req->address is set to the user's real IP address, as read from the
1753 HTTP_X_FORWARDED_FOR header.
1755 The host value for $c->req->base and $c->req->uri is set to the real host,
1756 as read from the HTTP_X_FORWARDED_HOST header.
1758 Obviously, your web server must support these 2 headers for this to work.
1760 In a more complex server farm environment where you may have your frontend
1761 proxy server(s) on different machines, you will need to set a configuration
1762 option to tell Catalyst to read the proxied data from the headers.
1764 MyApp->config->{using_frontend_proxy} = 1;
1766 If you do not wish to use the proxy support at all, you may set:
1768 MyApp->config->{ignore_frontend_proxy} = 1;
1770 =head1 THREAD SAFETY
1772 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1773 and the standalone forking HTTP server on Windows. We believe the Catalyst
1774 core to be thread-safe.
1776 If you plan to operate in a threaded environment, remember that all other
1777 modules you are using must also be thread-safe. Some modules, most notably
1778 DBD::SQLite, are not thread-safe.
1784 Join #catalyst on irc.perl.org.
1788 http://lists.rawmode.org/mailman/listinfo/catalyst
1789 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1793 http://catalyst.perl.org
1799 =item L<Catalyst::Manual> - The Catalyst Manual
1801 =item L<Catalyst::Engine> - Core Engine
1803 =item L<Catalyst::Log> - The Log Class.
1805 =item L<Catalyst::Request> - The Request Object
1807 =item L<Catalyst::Response> - The Response Object
1809 =item L<Catalyst::Test> - The test suite.
1877 Sebastian Riedel, C<sri@oook.de>
1881 This library is free software, you can redistribute it and/or modify it under
1882 the same terms as Perl itself.