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 depth request response state action namespace/
25 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
32 # For backwards compatibility
33 *finalize_output = \&finalize_body;
38 our $RECURSION = 1000;
39 our $DETACH = "catalyst_detach\n";
41 require Module::Pluggable::Fast;
43 # Helper script generation
44 our $CATALYST_SCRIPT_GEN = 10;
46 __PACKAGE__->mk_classdata($_)
47 for qw/components arguments dispatcher engine log dispatcher_class
48 engine_class context_class request_class response_class/;
50 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
51 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
52 __PACKAGE__->request_class('Catalyst::Request');
53 __PACKAGE__->response_class('Catalyst::Response');
55 our $VERSION = '5.49_03';
58 my ( $class, @arguments ) = @_;
60 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
62 return unless $class eq 'Catalyst';
64 my $caller = caller(0);
66 unless ( $caller->isa('Catalyst') ) {
68 push @{"$caller\::ISA"}, $class;
71 $caller->arguments( [@arguments] );
77 Catalyst - The Elegant MVC Web Application Framework
81 # use the helper to start a new application
85 # add models, views, controllers
86 script/myapp_create.pl model Something
87 script/myapp_create.pl view Stuff
88 script/myapp_create.pl controller Yada
91 script/myapp_server.pl
93 # command line interface
94 script/myapp_test.pl /yada
99 use Catalyst qw/My::Module My::OtherModule/;
101 use Catalyst '-Debug';
103 use Catalyst qw/-Debug -Engine=CGI/;
105 sub default : Private { $_[1]->res->output('Hello') } );
107 sub index : Path('/index.html') {
108 my ( $self, $c ) = @_;
109 $c->res->output('Hello');
113 sub product : Regex('^product[_]*(\d*).html$') {
114 my ( $self, $c ) = @_;
115 $c->stash->{template} = 'product.tt';
116 $c->stash->{product} = $c->req->snippets->[0];
119 See also L<Catalyst::Manual::Intro>
123 The key concept of Catalyst is DRY (Don't Repeat Yourself).
125 See L<Catalyst::Manual> for more documentation.
127 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
128 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
129 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
131 use Catalyst 'My::Module';
133 Special flags like -Debug and -Engine can also be specified as arguments when
136 use Catalyst qw/-Debug My::Module/;
138 The position of plugins and flags in the chain is important, because they are
139 loaded in exactly the order that they appear.
141 The following flags are supported:
147 enables debug output, i.e.:
149 use Catalyst '-Debug';
151 this is equivalent to:
158 Force Catalyst to use a specific dispatcher.
162 Force Catalyst to use a specific engine.
163 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
165 use Catalyst '-Engine=CGI';
169 Force Catalyst to use a specific home directory.
183 Accessor for the current action
185 =item $c->comp($name)
187 =item $c->component($name)
189 Get a component object by name.
191 $c->comp('MyApp::Model::MyModel')->do_stuff;
202 my $appclass = ref $c || $c;
205 $name, "${appclass}::${name}",
206 map { "${appclass}::${_}::${name}" } qw/M V C/
209 foreach my $try (@names) {
211 if ( exists $c->components->{$try} ) {
213 return $c->components->{$try};
217 foreach my $component ( keys %{ $c->components } ) {
219 return $c->components->{$component} if $component =~ /$name/i;
224 return sort keys %{ $c->components };
229 Returns a hashref containing your applications settings.
233 =item $c->controller($name)
235 Get a L<Catalyst::Controller> instance by name.
237 $c->controller('Foo')->do_stuff;
242 my ( $c, $name ) = @_;
243 my $controller = $c->comp("Controller::$name");
244 return $controller if $controller;
245 return $c->comp("C::$name");
250 Overload to enable debug messages.
256 =item $c->detach( $command [, \@arguments ] )
258 Like C<forward> but doesn't return.
262 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
266 Contains the dispatcher instance.
267 Stringifies to class.
269 =item $c->forward( $command [, \@arguments ] )
271 Forward processing to a private action or a method from a class.
272 If you define a class without method it will default to process().
273 also takes an optional arrayref containing arguments to be passed
274 to the new function. $c->req->args will be reset upon returning
278 $c->forward('index');
279 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
280 $c->forward('MyApp::View::TT');
284 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
286 =item $c->model($name)
288 Get a L<Catalyst::Model> instance by name.
290 $c->model('Foo')->do_stuff;
295 my ( $c, $name ) = @_;
296 my $model = $c->comp("Model::$name");
297 return $model if $model;
298 return $c->comp("M::$name");
303 Accessor to the namespace of the current action
305 =item $c->path_to(@path)
307 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
311 $c->path_to( 'db', 'sqlite.db' );
316 my ( $c, @path ) = @_;
317 my $path = dir( $c->config->{home}, @path );
318 if ( -d $path ) { return $path }
319 else { return file( $c->config->{home}, @path ) }
331 my ( $class, @arguments ) = @_;
333 unless ( $class->isa('Catalyst') ) {
335 Catalyst::Exception->throw(
336 message => qq/'$class' does not inherit from Catalyst/ );
339 if ( $class->arguments ) {
340 @arguments = ( @arguments, @{ $class->arguments } );
346 foreach (@arguments) {
350 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
352 elsif (/^-(\w+)=?(.*)$/) {
353 $flags->{ lc $1 } = $2;
356 push @{ $flags->{plugins} }, $_;
360 $class->setup_log( delete $flags->{log} );
361 $class->setup_plugins( delete $flags->{plugins} );
362 $class->setup_dispatcher( delete $flags->{dispatcher} );
363 $class->setup_engine( delete $flags->{engine} );
364 $class->setup_home( delete $flags->{home} );
366 for my $flag ( sort keys %{$flags} ) {
368 if ( my $code = $class->can( 'setup_' . $flag ) ) {
369 &$code( $class, delete $flags->{$flag} );
372 $class->log->warn(qq/Unknown flag "$flag"/);
376 $class->log->warn( "You are running an old helper script! "
377 . "Please update your scripts by regenerating the "
378 . "application and copying over the new scripts." )
379 if ( $ENV{CATALYST_SCRIPT_GEN}
380 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
382 if ( $class->debug ) {
388 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
392 my $t = Text::SimpleTable->new(76);
393 $t->row($_) for @plugins;
394 $class->log->debug( "Loaded plugins:\n" . $t->draw );
397 my $dispatcher = $class->dispatcher;
398 my $engine = $class->engine;
399 my $home = $class->config->{home};
401 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
402 $class->log->debug(qq/Loaded engine "$engine"/);
406 ? $class->log->debug(qq/Found home "$home"/)
407 : $class->log->debug(qq/Home "$home" doesn't exist/)
408 : $class->log->debug(q/Couldn't find home/);
413 no warnings qw/redefine/;
414 local *setup = sub { };
418 # Initialize our data structure
419 $class->components( {} );
421 $class->setup_components;
423 if ( $class->debug ) {
424 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
425 for my $comp ( sort keys %{ $class->components } ) {
426 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
427 $t->row( $comp, $type );
429 $class->log->debug( "Loaded components:\n" . $t->draw )
430 if ( keys %{ $class->components } );
433 # Add our self to components, since we are also a component
434 $class->components->{$class} = $class;
436 $class->setup_actions;
438 if ( $class->debug ) {
439 my $name = $class->config->{name} || 'Application';
440 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
442 $class->log->_flush() if $class->log->can('_flush');
445 =item $c->uri_for($path,[@args])
447 Merges path with $c->request->base for absolute uri's and with
448 $c->request->match for relative uri's, then returns a normalized
449 L<URI> object. If any args are passed, they are added at the end
455 my ( $c, $path, @args ) = @_;
456 my $base = $c->request->base->clone;
457 my $basepath = $base->path;
458 $basepath =~ s/\/$//;
460 my $match = $c->request->match;
462 # massage match, empty if absolute path
464 $match .= '/' if $match;
466 $match = '' if $path =~ /^\//;
469 # join args with '/', or a blank string
470 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
471 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
477 =item $c->error($error, ...)
479 =item $c->error($arrayref)
481 Returns an arrayref containing error messages.
483 my @error = @{ $c->error };
487 $c->error('Something bad happened');
498 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
499 push @{ $c->{error} }, @$error;
501 elsif ( defined $_[0] ) { $c->{error} = undef }
502 return $c->{error} || [];
507 Contains the engine instance.
508 Stringifies to the class.
512 Contains the logging object. Unless it is already set Catalyst sets this up with a
513 C<Catalyst::Log> object. To use your own log class:
515 $c->log( MyLogger->new );
516 $c->log->info("now logging with my own logger!");
518 Your log class should implement the methods described in the C<Catalyst::Log>
521 =item $c->plugin( $name, $class, @args )
523 Instant plugins for Catalyst.
524 Classdata accessor/mutator will be created, class loaded and instantiated.
526 MyApp->plugin( 'prototype', 'HTML::Prototype' );
528 $c->prototype->define_javascript_functions;
533 my ( $class, $name, $plugin, @args ) = @_;
536 if ( my $error = $UNIVERSAL::require::ERROR ) {
537 Catalyst::Exception->throw(
538 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
541 eval { $plugin->import };
542 $class->mk_classdata($name);
544 eval { $obj = $plugin->new(@args) };
547 Catalyst::Exception->throw( message =>
548 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
552 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
560 Returns a C<Catalyst::Request> object.
568 Returns a C<Catalyst::Response> object.
574 Contains the return value of the last executed action.
578 Returns a hashref containing all your data.
580 print $c->stash->{foo};
582 Keys may be set in the stash by assigning to the hash reference, or by passing
583 either a single hash reference or a list of key/value pairs as arguments.
587 $c->stash->{foo} ||= 'yada';
588 $c->stash( { moose => 'majestic', qux => 0 } );
589 $c->stash( bar => 1, gorch => 2 );
596 my $stash = @_ > 1 ? {@_} : $_[0];
597 while ( my ( $key, $val ) = each %$stash ) {
598 $c->{stash}->{$key} = $val;
604 =item $c->view($name)
606 Get a L<Catalyst::View> instance by name.
608 $c->view('Foo')->do_stuff;
613 my ( $c, $name ) = @_;
614 my $view = $c->comp("View::$name");
615 return $view if $view;
616 return $c->comp("V::$name");
619 =item $c->welcome_message
621 Returns the Catalyst welcome HTML page.
625 sub welcome_message {
627 my $name = $c->config->{name};
628 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
629 my $prefix = Catalyst::Utils::appprefix( ref $c );
630 $c->response->content_type('text/html; charset=utf-8');
632 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
633 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
634 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
636 <meta http-equiv="Content-Language" content="en" />
637 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
638 <title>$name on Catalyst $VERSION</title>
639 <style type="text/css">
642 background-color: #eee;
651 background-color: #ccc;
652 border: 1px solid #aaa;
653 -moz-border-radius: 10px;
658 font-family: verdana, tahoma, sans-serif;
661 font-family: verdana, tahoma, sans-serif;
664 text-decoration: none;
666 border-bottom: 1px dotted #bbb;
668 :link:hover, :visited:hover {
681 background-color: #fff;
682 border: 1px solid #aaa;
683 -moz-border-radius: 10px;
709 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
714 <img src="$logo" alt="Catalyst Logo" />
716 <p>Welcome to the wonderful world of Catalyst.
717 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
718 framework will make web development something you had
719 never expected it to be: Fun, rewarding and quick.</p>
720 <h2>What to do now?</h2>
721 <p>That really depends on what <b>you</b> want to do.
722 We do, however, provide you with a few starting points.</p>
723 <p>If you want to jump right into web development with Catalyst
724 you might want to check out the documentation.</p>
725 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
726 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
727 <h2>What to do next?</h2>
728 <p>Next it's time to write an actual application. Use the
729 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
730 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
731 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
732 they can save you a lot of work.</p>
733 <pre><code>script/${prefix}_create.pl -help</code></pre>
734 <p>Also, be sure to check out the vast and growing
735 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
736 you are likely to find what you need there.
740 <p>Catalyst has a very active community. Here are the main places to
741 get in touch with us.</p>
744 <a href="http://dev.catalyst.perl.org">Wiki</a>
747 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
750 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
753 <h2>In conclusion</h2>
754 <p>The Catalyst team hopes you will enjoy using Catalyst as much
755 as we enjoyed making it. Please contact us if you have ideas
756 for improvement or other feedback.</p>
766 =head1 INTERNAL METHODS
770 =item $c->benchmark($coderef)
772 Takes a coderef with arguments and returns elapsed time as float.
774 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
775 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
782 my $time = [gettimeofday];
783 my @return = &$code(@_);
784 my $elapsed = tv_interval $time;
785 return wantarray ? ( $elapsed, @return ) : $elapsed;
790 Contains the components.
794 Returns a hashref containing coderefs and execution counts.
795 (Needed for deep recursion detection)
799 Returns the actual forward depth.
803 Dispatch request to actions.
807 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
811 Returns a list of 2-element array references (name, structure) pairs that will
812 be dumped on the error page in debug mode.
818 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
821 =item $c->execute($class, $coderef)
823 Execute a coderef in given class and catch exceptions.
824 Errors are available via $c->error.
829 my ( $c, $class, $code ) = @_;
830 $class = $c->components->{$class} || $class;
832 my $callsub = ( caller(1) )[3];
837 $action = "/$action" unless $action =~ /\-\>/;
838 $c->counter->{"$code"}++;
840 if ( $c->counter->{"$code"} > $RECURSION ) {
841 my $error = qq/Deep recursion detected in "$action"/;
842 $c->log->error($error);
848 $action = "-> $action" if $callsub =~ /forward$/;
854 my ( $elapsed, @state ) =
855 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
856 unless ( ( $code->name =~ /^_.*/ )
857 && ( !$c->config->{show_internal_actions} ) )
859 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
864 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
869 if ( my $error = $@ ) {
871 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
873 unless ( ref $error ) {
875 $error = qq/Caught exception "$error"/;
893 for my $error ( @{ $c->error } ) {
894 $c->log->error($error);
897 $c->finalize_uploads;
900 if ( $#{ $c->error } >= 0 ) {
904 $c->finalize_headers;
907 if ( $c->request->method eq 'HEAD' ) {
908 $c->response->body('');
913 return $c->response->status;
916 =item $c->finalize_body
922 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
924 =item $c->finalize_cookies
930 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
932 =item $c->finalize_error
938 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
940 =item $c->finalize_headers
946 sub finalize_headers {
949 # Check if we already finalized headers
950 return if $c->response->{_finalized_headers};
953 if ( my $location = $c->response->redirect ) {
954 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
955 $c->response->header( Location => $location );
959 if ( $c->response->body && !$c->response->content_length ) {
960 $c->response->content_length( bytes::length( $c->response->body ) );
964 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
965 $c->response->headers->remove_header("Content-Length");
966 $c->response->body('');
969 $c->finalize_cookies;
971 $c->engine->finalize_headers( $c, @_ );
974 $c->response->{_finalized_headers} = 1;
977 =item $c->finalize_output
979 An alias for finalize_body.
981 =item $c->finalize_read
983 Finalize the input after reading is complete.
987 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
989 =item $c->finalize_uploads
991 Finalize uploads. Cleans up any temporary files.
995 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
997 =item $c->get_action( $action, $namespace )
999 Get an action in a given namespace.
1003 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1005 =item $c->get_actions( $action, $namespace )
1007 Get all actions of a given name in a namespace and all base namespaces.
1011 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1013 =item handle_request( $class, @arguments )
1015 Handles the request.
1019 sub handle_request {
1020 my ( $class, @arguments ) = @_;
1022 # Always expect worst case!
1028 my $c = $class->prepare(@arguments);
1029 $c->{stats} = \@stats;
1031 return $c->finalize;
1034 if ( $class->debug ) {
1036 ( $elapsed, $status ) = $class->benchmark($handler);
1037 $elapsed = sprintf '%f', $elapsed;
1038 my $av = sprintf '%.3f',
1039 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1040 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1042 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1044 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1046 else { $status = &$handler }
1050 if ( my $error = $@ ) {
1052 $class->log->error(qq/Caught exception in engine "$error"/);
1056 $class->log->_flush() if $class->log->can('_flush');
1060 =item $c->prepare(@arguments)
1062 Turns the engine-specific request( Apache, CGI ... )
1063 into a Catalyst context .
1068 my ( $class, @arguments ) = @_;
1070 $class->context_class( ref $class || $class ) unless $class->context_class;
1071 my $c = $class->context_class->new(
1075 request => $class->request_class->new(
1078 body_parameters => {},
1080 headers => HTTP::Headers->new,
1082 query_parameters => {},
1088 response => $class->response_class->new(
1092 headers => HTTP::Headers->new(),
1101 # For on-demand data
1102 $c->request->{_context} = $c;
1103 $c->response->{_context} = $c;
1104 weaken( $c->request->{_context} );
1105 weaken( $c->response->{_context} );
1108 my $secs = time - $START || 1;
1109 my $av = sprintf '%.3f', $COUNT / $secs;
1110 $c->log->debug('**********************************');
1111 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1112 $c->log->debug('**********************************');
1113 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1116 $c->prepare_request(@arguments);
1117 $c->prepare_connection;
1118 $c->prepare_query_parameters;
1119 $c->prepare_headers;
1120 $c->prepare_cookies;
1124 $c->prepare_body unless $c->config->{parse_on_demand};
1127 my $method = $c->req->method || '';
1128 my $path = $c->req->path || '';
1129 my $address = $c->req->address || '';
1131 $c->log->debug(qq/"$method" request for "$path" from $address/)
1137 =item $c->prepare_action
1143 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1145 =item $c->prepare_body
1147 Prepare message body.
1154 # Do we run for the first time?
1155 return if defined $c->request->{_body};
1157 # Initialize on-demand data
1158 $c->engine->prepare_body( $c, @_ );
1159 $c->prepare_parameters;
1160 $c->prepare_uploads;
1162 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1163 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1164 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1165 my $param = $c->req->body_parameters->{$key};
1166 my $value = defined($param) ? $param : '';
1168 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1170 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1174 =item $c->prepare_body_chunk( $chunk )
1176 Prepare a chunk of data before sending it to HTTP::Body.
1180 sub prepare_body_chunk {
1182 $c->engine->prepare_body_chunk( $c, @_ );
1185 =item $c->prepare_body_parameters
1187 Prepare body parameters.
1191 sub prepare_body_parameters {
1193 $c->engine->prepare_body_parameters( $c, @_ );
1196 =item $c->prepare_connection
1202 sub prepare_connection {
1204 $c->engine->prepare_connection( $c, @_ );
1207 =item $c->prepare_cookies
1213 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1215 =item $c->prepare_headers
1221 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1223 =item $c->prepare_parameters
1229 sub prepare_parameters {
1231 $c->prepare_body_parameters;
1232 $c->engine->prepare_parameters( $c, @_ );
1235 =item $c->prepare_path
1237 Prepare path and base.
1241 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1243 =item $c->prepare_query_parameters
1245 Prepare query parameters.
1249 sub prepare_query_parameters {
1252 $c->engine->prepare_query_parameters( $c, @_ );
1254 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1255 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1256 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1257 my $param = $c->req->query_parameters->{$key};
1258 my $value = defined($param) ? $param : '';
1260 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1262 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1266 =item $c->prepare_read
1268 Prepare the input for reading.
1272 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1274 =item $c->prepare_request
1276 Prepare the engine request.
1280 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1282 =item $c->prepare_uploads
1288 sub prepare_uploads {
1291 $c->engine->prepare_uploads( $c, @_ );
1293 if ( $c->debug && keys %{ $c->request->uploads } ) {
1294 my $t = Text::SimpleTable->new(
1300 for my $key ( sort keys %{ $c->request->uploads } ) {
1301 my $upload = $c->request->uploads->{$key};
1302 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1303 $t->row( $key, $u->filename, $u->type, $u->size );
1306 $c->log->debug( "File Uploads are:\n" . $t->draw );
1310 =item $c->prepare_write
1312 Prepare the output for writing.
1316 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1318 =item $c->read( [$maxlength] )
1320 Read a chunk of data from the request body. This method is designed to be
1321 used in a while loop, reading $maxlength bytes on every call. $maxlength
1322 defaults to the size of the request if not specified.
1324 You have to set MyApp->config->{parse_on_demand} to use this directly.
1328 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1336 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1338 =item $c->set_action( $action, $code, $namespace, $attrs )
1340 Set an action in a given namespace.
1344 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1346 =item $c->setup_actions($component)
1348 Setup actions for a component.
1352 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1354 =item $c->setup_components
1360 sub setup_components {
1363 my $callback = sub {
1364 my ( $component, $context ) = @_;
1366 unless ( $component->isa('Catalyst::Component') ) {
1370 my $suffix = Catalyst::Utils::class2classsuffix($class);
1371 my $config = $class->config->{$suffix} || {};
1375 eval { $instance = $component->new( $context, $config ); };
1377 if ( my $error = $@ ) {
1381 Catalyst::Exception->throw( message =>
1382 qq/Couldn't instantiate component "$component", "$error"/ );
1385 Catalyst::Exception->throw( message =>
1386 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1388 unless ref $instance;
1393 Module::Pluggable::Fast->import(
1394 name => '_catalyst_components',
1396 "$class\::Controller", "$class\::C",
1397 "$class\::Model", "$class\::M",
1398 "$class\::View", "$class\::V"
1400 callback => $callback
1404 if ( my $error = $@ ) {
1408 Catalyst::Exception->throw(
1409 message => qq/Couldn't load components "$error"/ );
1412 for my $component ( $class->_catalyst_components($class) ) {
1413 $class->components->{ ref $component || $component } = $component;
1417 =item $c->setup_dispatcher
1421 sub setup_dispatcher {
1422 my ( $class, $dispatcher ) = @_;
1425 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1428 if ( $ENV{CATALYST_DISPATCHER} ) {
1429 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1432 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1434 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1437 unless ($dispatcher) {
1438 $dispatcher = $class->dispatcher_class;
1441 $dispatcher->require;
1444 Catalyst::Exception->throw(
1445 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1448 # dispatcher instance
1449 $class->dispatcher( $dispatcher->new );
1452 =item $c->setup_engine
1457 my ( $class, $engine ) = @_;
1460 $engine = 'Catalyst::Engine::' . $engine;
1463 if ( $ENV{CATALYST_ENGINE} ) {
1464 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1467 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1468 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1471 if ( !$engine && $ENV{MOD_PERL} ) {
1473 # create the apache method
1476 *{"$class\::apache"} = sub { shift->engine->apache };
1479 my ( $software, $version ) =
1480 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1483 $version =~ s/(\.[^.]+)\./$1/g;
1485 if ( $software eq 'mod_perl' ) {
1487 if ( $version >= 1.99922 ) {
1488 $engine = 'Catalyst::Engine::Apache2::MP20';
1491 elsif ( $version >= 1.9901 ) {
1492 $engine = 'Catalyst::Engine::Apache2::MP19';
1495 elsif ( $version >= 1.24 ) {
1496 $engine = 'Catalyst::Engine::Apache::MP13';
1500 Catalyst::Exception->throw( message =>
1501 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1504 # install the correct mod_perl handler
1505 if ( $version >= 1.9901 ) {
1506 *handler = sub : method {
1507 shift->handle_request(@_);
1511 *handler = sub ($$) { shift->handle_request(@_) };
1516 elsif ( $software eq 'Zeus-Perl' ) {
1517 $engine = 'Catalyst::Engine::Zeus';
1521 Catalyst::Exception->throw(
1522 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1527 $engine = $class->engine_class;
1533 Catalyst::Exception->throw( message =>
1534 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1538 # check for old engines that are no longer compatible
1540 if ( $engine->isa('Catalyst::Engine::Apache')
1541 && !Catalyst::Engine::Apache->VERSION )
1546 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1547 && Catalyst::Engine::Server->VERSION le '0.02' )
1552 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1553 && $engine->VERSION eq '0.01' )
1558 elsif ($engine->isa('Catalyst::Engine::Zeus')
1559 && $engine->VERSION eq '0.01' )
1565 Catalyst::Exception->throw( message =>
1566 qq/Engine "$engine" is not supported by this version of Catalyst/
1571 $class->engine( $engine->new );
1574 =item $c->setup_home
1579 my ( $class, $home ) = @_;
1581 if ( $ENV{CATALYST_HOME} ) {
1582 $home = $ENV{CATALYST_HOME};
1585 if ( $ENV{ uc($class) . '_HOME' } ) {
1586 $home = $ENV{ uc($class) . '_HOME' };
1590 $home = Catalyst::Utils::home($class);
1594 $class->config->{home} ||= $home;
1595 $class->config->{root} ||= dir($home)->subdir('root');
1604 my ( $class, $debug ) = @_;
1606 unless ( $class->log ) {
1607 $class->log( Catalyst::Log->new );
1610 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1613 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1614 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1619 *{"$class\::debug"} = sub { 1 };
1620 $class->log->debug('Debug messages enabled');
1624 =item $c->setup_plugins
1629 my ( $class, $plugins ) = @_;
1632 for my $plugin ( reverse @$plugins ) {
1634 $plugin = "Catalyst::Plugin::$plugin";
1639 Catalyst::Exception->throw(
1640 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1645 unshift @{"$class\::ISA"}, $plugin;
1650 =item $c->write( $data )
1652 Writes $data to the output stream. When using this method directly, you will
1653 need to manually set the Content-Length header to the length of your output
1661 # Finalize headers if someone manually writes output
1662 $c->finalize_headers;
1664 return $c->engine->write( $c, @_ );
1669 Returns the Catalyst version number. mostly useful for powered by messages
1670 in template systems.
1674 sub version { return $Catalyst::VERSION }
1678 =head1 INTERNAL ACTIONS
1680 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1681 C<_ACTION> and C<_END>, these are by default not shown in the private
1684 But you can deactivate this with a config parameter.
1686 MyApp->config->{show_internal_actions} = 1;
1688 =head1 CASE SENSITIVITY
1690 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1693 But you can activate case sensitivity with a config parameter.
1695 MyApp->config->{case_sensitive} = 1;
1697 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1699 =head1 ON-DEMAND PARSER
1701 The request body is usually parsed at the beginning of a request,
1702 but if you want to handle input yourself or speed things up a bit
1703 you can enable on-demand parsing with a config parameter.
1705 MyApp->config->{parse_on_demand} = 1;
1707 =head1 PROXY SUPPORT
1709 Many production servers operate using the common double-server approach, with
1710 a lightweight frontend web server passing requests to a larger backend
1711 server. An application running on the backend server must deal with two
1712 problems: the remote user always appears to be '127.0.0.1' and the server's
1713 hostname will appear to be 'localhost' regardless of the virtual host the
1714 user connected through.
1716 Catalyst will automatically detect this situation when you are running both
1717 the frontend and backend servers on the same machine. The following changes
1718 are made to the request.
1720 $c->req->address is set to the user's real IP address, as read from the
1721 HTTP_X_FORWARDED_FOR header.
1723 The host value for $c->req->base and $c->req->uri is set to the real host,
1724 as read from the HTTP_X_FORWARDED_HOST header.
1726 Obviously, your web server must support these 2 headers for this to work.
1728 In a more complex server farm environment where you may have your frontend
1729 proxy server(s) on different machines, you will need to set a configuration
1730 option to tell Catalyst to read the proxied data from the headers.
1732 MyApp->config->{using_frontend_proxy} = 1;
1734 If you do not wish to use the proxy support at all, you may set:
1736 MyApp->config->{ignore_frontend_proxy} = 1;
1738 =head1 THREAD SAFETY
1740 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1741 and the standalone forking HTTP server on Windows. We believe the Catalyst
1742 core to be thread-safe.
1744 If you plan to operate in a threaded environment, remember that all other
1745 modules you are using must also be thread-safe. Some modules, most notably
1746 DBD::SQLite, are not thread-safe.
1752 Join #catalyst on irc.perl.org.
1756 http://lists.rawmode.org/mailman/listinfo/catalyst
1757 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1761 http://catalyst.perl.org
1767 =item L<Catalyst::Manual> - The Catalyst Manual
1769 =item L<Catalyst::Engine> - Core Engine
1771 =item L<Catalyst::Log> - The Log Class.
1773 =item L<Catalyst::Request> - The Request Object
1775 =item L<Catalyst::Response> - The Response Object
1777 =item L<Catalyst::Test> - The test suite.
1845 Sebastian Riedel, C<sri@oook.de>
1849 This library is free software, you can redistribute it and/or modify it under
1850 the same terms as Perl itself.