4 use base 'Catalyst::Base';
6 use UNIVERSAL::require;
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
16 use Time::HiRes qw/gettimeofday tv_interval/;
18 use Scalar::Util qw/weaken/;
20 __PACKAGE__->mk_accessors(
21 qw/counter depth request response state action namespace/
29 # For backwards compatibility
30 *finalize_output = \&finalize_body;
35 our $RECURSION = 1000;
36 our $DETACH = "catalyst_detach\n";
38 require Module::Pluggable::Fast;
40 # Helper script generation
41 our $CATALYST_SCRIPT_GEN = 9;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_02';
49 my ( $class, @arguments ) = @_;
51 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
53 return unless $class eq 'Catalyst';
55 my $caller = caller(0);
57 unless ( $caller->isa('Catalyst') ) {
59 push @{"$caller\::ISA"}, $class;
62 $caller->arguments( [@arguments] );
68 Catalyst - The Elegant MVC Web Application Framework
72 # use the helper to start a new application
76 # add models, views, controllers
77 script/myapp_create.pl model Something
78 script/myapp_create.pl view Stuff
79 script/myapp_create.pl controller Yada
82 script/myapp_server.pl
84 # command line interface
85 script/myapp_test.pl /yada
90 use Catalyst qw/My::Module My::OtherModule/;
92 use Catalyst '-Debug';
94 use Catalyst qw/-Debug -Engine=CGI/;
96 sub default : Private { $_[1]->res->output('Hello') } );
98 sub index : Path('/index.html') {
99 my ( $self, $c ) = @_;
100 $c->res->output('Hello');
104 sub product : Regex('^product[_]*(\d*).html$') {
105 my ( $self, $c ) = @_;
106 $c->stash->{template} = 'product.tt';
107 $c->stash->{product} = $c->req->snippets->[0];
110 See also L<Catalyst::Manual::Intro>
114 The key concept of Catalyst is DRY (Don't Repeat Yourself).
116 See L<Catalyst::Manual> for more documentation.
118 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
119 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
120 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
122 use Catalyst 'My::Module';
124 Special flags like -Debug and -Engine can also be specified as arguments when
127 use Catalyst qw/-Debug My::Module/;
129 The position of plugins and flags in the chain is important, because they are
130 loaded in exactly the order that they appear.
132 The following flags are supported:
138 enables debug output, i.e.:
140 use Catalyst '-Debug';
142 this is equivalent to:
149 Force Catalyst to use a specific dispatcher.
153 Force Catalyst to use a specific engine.
154 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
156 use Catalyst '-Engine=CGI';
160 Force Catalyst to use a specific home directory.
174 Accessor for the current action
176 =item $c->comp($name)
178 =item $c->component($name)
180 Get a component object by name.
182 $c->comp('MyApp::Model::MyModel')->do_stuff;
193 my $appclass = ref $c || $c;
196 $name, "${appclass}::${name}",
197 map { "${appclass}::${_}::${name}" } qw/M V C/
200 foreach my $try (@names) {
202 if ( exists $c->components->{$try} ) {
204 return $c->components->{$try};
208 foreach my $component ( keys %{ $c->components } ) {
210 return $c->components->{$component} if $component =~ /$name/i;
215 return sort keys %{ $c->components };
220 Returns a hashref containing your applications settings.
224 Overload to enable debug messages.
230 =item $c->detach( $command [, \@arguments ] )
232 Like C<forward> but doesn't return.
236 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
240 Contains the dispatcher instance.
241 Stringifies to class.
243 =item $c->forward( $command [, \@arguments ] )
245 Forward processing to a private action or a method from a class.
246 If you define a class without method it will default to process().
247 also takes an optional arrayref containing arguments to be passed
248 to the new function. $c->req->args will be reset upon returning
252 $c->forward('index');
253 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
254 $c->forward('MyApp::View::TT');
258 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
262 Accessor to the namespace of the current action
264 =item $c->path_to(@path)
266 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
270 $c->path_to( 'db', 'sqlite.db' );
275 my ( $c, @path ) = @_;
276 my $path = dir( $c->config->{home}, @path );
277 if ( -d $path ) { return $path }
278 else { return file( $c->config->{home}, @path ) }
290 my ( $class, @arguments ) = @_;
292 unless ( $class->isa('Catalyst') ) {
294 Catalyst::Exception->throw(
295 message => qq/'$class' does not inherit from Catalyst/ );
298 if ( $class->arguments ) {
299 @arguments = ( @arguments, @{ $class->arguments } );
305 foreach (@arguments) {
309 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
311 elsif (/^-(\w+)=?(.*)$/) {
312 $flags->{ lc $1 } = $2;
315 push @{ $flags->{plugins} }, $_;
319 $class->setup_log( delete $flags->{log} );
320 $class->setup_plugins( delete $flags->{plugins} );
321 $class->setup_dispatcher( delete $flags->{dispatcher} );
322 $class->setup_engine( delete $flags->{engine} );
323 $class->setup_home( delete $flags->{home} );
325 for my $flag ( sort keys %{$flags} ) {
327 if ( my $code = $class->can( 'setup_' . $flag ) ) {
328 &$code( $class, delete $flags->{$flag} );
331 $class->log->warn(qq/Unknown flag "$flag"/);
335 $class->log->warn( "You are running an old helper script! "
336 . "Please update your scripts by regenerating the "
337 . "application and copying over the new scripts." )
338 if ( $ENV{CATALYST_SCRIPT_GEN}
339 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
341 if ( $class->debug ) {
347 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
351 my $t = Text::ASCIITable->new;
352 $t->setOptions( 'hide_HeadRow', 1 );
353 $t->setOptions( 'hide_HeadLine', 1 );
354 $t->setCols('Class');
355 $t->setColWidth( 'Class', 75, 1 );
356 $t->addRow($_) for @plugins;
357 $class->log->debug( "Loaded plugins:\n" . $t->draw );
360 my $dispatcher = $class->dispatcher;
361 my $engine = $class->engine;
362 my $home = $class->config->{home};
364 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
365 $class->log->debug(qq/Loaded engine "$engine"/);
369 ? $class->log->debug(qq/Found home "$home"/)
370 : $class->log->debug(qq/Home "$home" doesn't exist/)
371 : $class->log->debug(q/Couldn't find home/);
376 no warnings qw/redefine/;
377 local *setup = sub { };
381 # Initialize our data structure
382 $class->components( {} );
384 $class->setup_components;
386 if ( $class->debug ) {
387 my $t = Text::ASCIITable->new;
388 $t->setOptions( 'hide_HeadRow', 1 );
389 $t->setOptions( 'hide_HeadLine', 1 );
390 $t->setCols('Class');
391 $t->setColWidth( 'Class', 75, 1 );
392 $t->addRow($_) for sort keys %{ $class->components };
393 $class->log->debug( "Loaded components:\n" . $t->draw )
394 if ( @{ $t->{tbl_rows} } );
397 # Add our self to components, since we are also a component
398 $class->components->{$class} = $class;
400 $class->setup_actions;
402 if ( $class->debug ) {
403 my $name = $class->config->{name} || 'Application';
404 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
406 $class->log->_flush() if $class->log->can('_flush');
409 =item $c->uri_for($path,[@args])
411 Merges path with $c->request->base for absolute uri's and with
412 $c->request->match for relative uri's, then returns a normalized
413 L<URI> object. If any args are passed, they are added at the end
419 my ( $c, $path, @args ) = @_;
420 my $base = $c->request->base->clone;
421 my $basepath = $base->path;
422 $basepath =~ s/\/$//;
424 my $match = $c->request->match;
426 # massage match, empty if absolute path
428 $match .= '/' if $match;
429 $match = '' if $path =~ /^\//;
432 # join args with '/', or a blank string
433 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
434 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
440 =item $c->error($error, ...)
442 =item $c->error($arrayref)
444 Returns an arrayref containing error messages.
446 my @error = @{ $c->error };
450 $c->error('Something bad happened');
461 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
462 push @{ $c->{error} }, @$error;
464 elsif ( defined $_[0] ) { $c->{error} = undef }
465 return $c->{error} || [];
470 Contains the engine instance.
471 Stringifies to the class.
475 Contains the logging object. Unless it is already set Catalyst sets this up with a
476 C<Catalyst::Log> object. To use your own log class:
478 $c->log( MyLogger->new );
479 $c->log->info("now logging with my own logger!");
481 Your log class should implement the methods described in the C<Catalyst::Log>
484 =item $c->plugin( $name, $class, @args )
486 Instant plugins for Catalyst.
487 Classdata accessor/mutator will be created, class loaded and instantiated.
489 MyApp->plugin( 'prototype', 'HTML::Prototype' );
491 $c->prototype->define_javascript_functions;
496 my ( $class, $name, $plugin, @args ) = @_;
499 if ( my $error = $UNIVERSAL::require::ERROR ) {
500 Catalyst::Exception->throw(
501 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
504 eval { $plugin->import };
505 $class->mk_classdata($name);
507 eval { $obj = $plugin->new(@args) };
510 Catalyst::Exception->throw( message =>
511 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
515 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
523 Returns a C<Catalyst::Request> object.
531 Returns a C<Catalyst::Response> object.
537 Contains the return value of the last executed action.
541 Returns a hashref containing all your data.
543 print $c->stash->{foo};
545 Keys may be set in the stash by assigning to the hash reference, or by passing
546 either a single hash reference or a list of key/value pairs as arguments.
550 $c->stash->{foo} ||= 'yada';
551 $c->stash( { moose => 'majestic', qux => 0 } );
552 $c->stash( bar => 1, gorch => 2 );
559 my $stash = @_ > 1 ? {@_} : $_[0];
560 while ( my ( $key, $val ) = each %$stash ) {
561 $c->{stash}->{$key} = $val;
567 =item $c->welcome_message
569 Returns the Catalyst welcome HTML page.
573 sub welcome_message {
575 my $name = $c->config->{name};
576 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
577 my $prefix = Catalyst::Utils::appprefix( ref $c );
581 <title>$name on Catalyst $VERSION</title>
582 <style type="text/css">
587 background-color: #eee;
595 background-color: #ccc;
596 border: 1px solid #aaa;
597 -moz-border-radius: 10px;
602 font-family: verdana, tahoma, sans-serif;
605 font-family: verdana, tahoma, sans-serif;
608 text-decoration: none;
610 border-bottom: 1px dotted #bbb;
612 :link:hover, :visited:hover {
625 background-color: #fff;
626 border: 1px solid #aaa;
627 -moz-border-radius: 10px;
652 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
659 <p>Welcome to the wonderful world of Catalyst.
660 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
661 framework will make web development something you had
662 never expected it to be: Fun, rewarding and quick.</p>
663 <h2>What to do now?</h2>
664 <p>That really depends on what <b>you</b> want to do.
665 We do, however, provide you with a few starting points.</p>
666 <p>If you want to jump right into web development with Catalyst
667 you might want to check out the documentation.</p>
668 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
669 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
670 <h2>What to do next?</h2>
671 <p>Next it's time to write an actual application. Use the
672 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
673 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
674 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
675 they can save you a lot of work.</p>
676 <pre><code>script/${prefix}_create.pl -help</code></pre>
677 <p>Also, be sure to check out the vast and growing
678 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
679 you are likely to find what you need there.
683 <p>Catalyst has a very active community. Here are the main places to
684 get in touch with us.</p>
687 <a href="http://dev.catalyst.perl.org">Wiki</a>
690 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
693 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
696 <h2>In conclusion</h2>
697 <p>The Catalyst team hopes you will enjoy using Catalyst as much
698 as we enjoyed making it. Please contact us if you have ideas
699 for improvement or other feedback.</p>
709 =head1 INTERNAL METHODS
713 =item $c->benchmark($coderef)
715 Takes a coderef with arguments and returns elapsed time as float.
717 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
718 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
725 my $time = [gettimeofday];
726 my @return = &$code(@_);
727 my $elapsed = tv_interval $time;
728 return wantarray ? ( $elapsed, @return ) : $elapsed;
733 Contains the components.
737 Returns a hashref containing coderefs and execution counts.
738 (Needed for deep recursion detection)
742 Returns the actual forward depth.
746 Dispatch request to actions.
750 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
754 Returns a list of 2-element array references (name, structure) pairs that will
755 be dumped on the error page in debug mode.
761 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
764 =item $c->execute($class, $coderef)
766 Execute a coderef in given class and catch exceptions.
767 Errors are available via $c->error.
772 my ( $c, $class, $code ) = @_;
773 $class = $c->components->{$class} || $class;
775 my $callsub = ( caller(1) )[3];
780 $action = "/$action" unless $action =~ /\-\>/;
781 $c->counter->{"$code"}++;
783 if ( $c->counter->{"$code"} > $RECURSION ) {
784 my $error = qq/Deep recursion detected in "$action"/;
785 $c->log->error($error);
791 $action = "-> $action" if $callsub =~ /forward$/;
797 my ( $elapsed, @state ) =
798 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
799 unless ( ( $code->name =~ /^_.*/ )
800 && ( !$c->config->{show_internal_actions} ) )
802 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
807 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
812 if ( my $error = $@ ) {
814 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
816 unless ( ref $error ) {
818 $error = qq/Caught exception "$error"/;
821 $c->log->error($error);
838 $c->finalize_uploads;
841 if ( $#{ $c->error } >= 0 ) {
845 $c->finalize_headers;
848 if ( $c->request->method eq 'HEAD' ) {
849 $c->response->body('');
854 return $c->response->status;
857 =item $c->finalize_body
863 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
865 =item $c->finalize_cookies
871 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
873 =item $c->finalize_error
879 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
881 =item $c->finalize_headers
887 sub finalize_headers {
890 # Check if we already finalized headers
891 return if $c->response->{_finalized_headers};
894 if ( my $location = $c->response->redirect ) {
895 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
896 $c->response->header( Location => $location );
900 if ( $c->response->body && !$c->response->content_length ) {
901 $c->response->content_length( bytes::length( $c->response->body ) );
905 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
906 $c->response->headers->remove_header("Content-Length");
907 $c->response->body('');
910 $c->finalize_cookies;
912 $c->engine->finalize_headers( $c, @_ );
915 $c->response->{_finalized_headers} = 1;
918 =item $c->finalize_output
920 An alias for finalize_body.
922 =item $c->finalize_read
924 Finalize the input after reading is complete.
928 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
930 =item $c->finalize_uploads
932 Finalize uploads. Cleans up any temporary files.
936 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
938 =item $c->get_action( $action, $namespace )
940 Get an action in a given namespace.
944 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
946 =item $c->get_actions( $action, $namespace )
948 Get all actions of a given name in a namespace and all base namespaces.
952 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
954 =item handle_request( $class, @arguments )
961 my ( $class, @arguments ) = @_;
963 # Always expect worst case!
969 my $c = $class->prepare(@arguments);
970 $c->{stats} = \@stats;
975 if ( $class->debug ) {
977 ( $elapsed, $status ) = $class->benchmark($handler);
978 $elapsed = sprintf '%f', $elapsed;
979 my $av = sprintf '%.3f',
980 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
981 my $t = Text::ASCIITable->new;
982 $t->setCols( 'Action', 'Time' );
983 $t->setColWidth( 'Action', 64, 1 );
984 $t->setColWidth( 'Time', 9, 1 );
986 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
988 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
990 else { $status = &$handler }
994 if ( my $error = $@ ) {
996 $class->log->error(qq/Caught exception in engine "$error"/);
1000 $class->log->_flush() if $class->log->can('_flush');
1004 =item $c->prepare(@arguments)
1006 Turns the engine-specific request( Apache, CGI ... )
1007 into a Catalyst context .
1012 my ( $class, @arguments ) = @_;
1017 request => Catalyst::Request->new(
1020 body_parameters => {},
1022 headers => HTTP::Headers->new,
1024 query_parameters => {},
1030 response => Catalyst::Response->new(
1034 headers => HTTP::Headers->new(),
1042 # For on-demand data
1043 $c->request->{_context} = $c;
1044 $c->response->{_context} = $c;
1045 weaken( $c->request->{_context} );
1046 weaken( $c->response->{_context} );
1049 my $secs = time - $START || 1;
1050 my $av = sprintf '%.3f', $COUNT / $secs;
1051 $c->log->debug('**********************************');
1052 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1053 $c->log->debug('**********************************');
1054 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1057 $c->prepare_request(@arguments);
1058 $c->prepare_connection;
1059 $c->prepare_query_parameters;
1060 $c->prepare_headers;
1061 $c->prepare_cookies;
1065 $c->prepare_body unless $c->config->{parse_on_demand};
1068 my $method = $c->req->method || '';
1069 my $path = $c->req->path || '';
1070 my $address = $c->req->address || '';
1072 $c->log->debug(qq/"$method" request for "$path" from $address/)
1078 =item $c->prepare_action
1084 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1086 =item $c->prepare_body
1088 Prepare message body.
1095 # Do we run for the first time?
1096 return if defined $c->request->{_body};
1098 # Initialize on-demand data
1099 $c->engine->prepare_body( $c, @_ );
1100 $c->prepare_parameters;
1101 $c->prepare_uploads;
1103 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1104 my $t = Text::ASCIITable->new;
1105 $t->setCols( 'Key', 'Value' );
1106 $t->setColWidth( 'Key', 37, 1 );
1107 $t->setColWidth( 'Value', 36, 1 );
1108 $t->alignCol( 'Value', 'right' );
1109 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1110 my $param = $c->req->body_parameters->{$key};
1111 my $value = defined($param) ? $param : '';
1113 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1115 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1119 =item $c->prepare_body_chunk( $chunk )
1121 Prepare a chunk of data before sending it to HTTP::Body.
1125 sub prepare_body_chunk {
1127 $c->engine->prepare_body_chunk( $c, @_ );
1130 =item $c->prepare_body_parameters
1132 Prepare body parameters.
1136 sub prepare_body_parameters {
1138 $c->engine->prepare_body_parameters( $c, @_ );
1141 =item $c->prepare_connection
1147 sub prepare_connection {
1149 $c->engine->prepare_connection( $c, @_ );
1152 =item $c->prepare_cookies
1158 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1160 =item $c->prepare_headers
1166 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1168 =item $c->prepare_parameters
1174 sub prepare_parameters {
1176 $c->prepare_body_parameters;
1177 $c->engine->prepare_parameters( $c, @_ );
1180 =item $c->prepare_path
1182 Prepare path and base.
1186 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1188 =item $c->prepare_query_parameters
1190 Prepare query parameters.
1194 sub prepare_query_parameters {
1197 $c->engine->prepare_query_parameters( $c, @_ );
1199 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1200 my $t = Text::ASCIITable->new;
1201 $t->setCols( 'Key', 'Value' );
1202 $t->setColWidth( 'Key', 37, 1 );
1203 $t->setColWidth( 'Value', 36, 1 );
1204 $t->alignCol( 'Value', 'right' );
1205 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1206 my $param = $c->req->query_parameters->{$key};
1207 my $value = defined($param) ? $param : '';
1209 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1211 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1215 =item $c->prepare_read
1217 Prepare the input for reading.
1221 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1223 =item $c->prepare_request
1225 Prepare the engine request.
1229 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1231 =item $c->prepare_uploads
1237 sub prepare_uploads {
1240 $c->engine->prepare_uploads( $c, @_ );
1242 if ( $c->debug && keys %{ $c->request->uploads } ) {
1243 my $t = Text::ASCIITable->new;
1244 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1245 $t->setColWidth( 'Key', 12, 1 );
1246 $t->setColWidth( 'Filename', 28, 1 );
1247 $t->setColWidth( 'Type', 18, 1 );
1248 $t->setColWidth( 'Size', 9, 1 );
1249 $t->alignCol( 'Size', 'left' );
1250 for my $key ( sort keys %{ $c->request->uploads } ) {
1251 my $upload = $c->request->uploads->{$key};
1252 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1253 $t->addRow( $key, $u->filename, $u->type, $u->size );
1256 $c->log->debug( "File Uploads are:\n" . $t->draw );
1260 =item $c->prepare_write
1262 Prepare the output for writing.
1266 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1268 =item $c->read( [$maxlength] )
1270 Read a chunk of data from the request body. This method is designed to be
1271 used in a while loop, reading $maxlength bytes on every call. $maxlength
1272 defaults to the size of the request if not specified.
1274 You have to set MyApp->config->{parse_on_demand} to use this directly.
1278 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1286 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1288 =item $c->set_action( $action, $code, $namespace, $attrs )
1290 Set an action in a given namespace.
1294 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1296 =item $c->setup_actions($component)
1298 Setup actions for a component.
1302 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1304 =item $c->setup_components
1310 sub setup_components {
1313 my $callback = sub {
1314 my ( $component, $context ) = @_;
1316 unless ( $component->isa('Catalyst::Base') ) {
1320 my $suffix = Catalyst::Utils::class2classsuffix($component);
1321 my $config = $class->config->{$suffix} || {};
1325 eval { $instance = $component->new( $context, $config ); };
1327 if ( my $error = $@ ) {
1331 Catalyst::Exception->throw( message =>
1332 qq/Couldn't instantiate component "$component", "$error"/ );
1335 Catalyst::Exception->throw( message =>
1336 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1338 unless ref $instance;
1343 Module::Pluggable::Fast->import(
1344 name => '_catalyst_components',
1346 "$class\::Controller", "$class\::C",
1347 "$class\::Model", "$class\::M",
1348 "$class\::View", "$class\::V"
1350 callback => $callback
1354 if ( my $error = $@ ) {
1358 Catalyst::Exception->throw(
1359 message => qq/Couldn't load components "$error"/ );
1362 for my $component ( $class->_catalyst_components($class) ) {
1363 $class->components->{ ref $component || $component } = $component;
1367 =item $c->setup_dispatcher
1371 sub setup_dispatcher {
1372 my ( $class, $dispatcher ) = @_;
1375 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1378 if ( $ENV{CATALYST_DISPATCHER} ) {
1379 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1382 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1384 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1387 unless ($dispatcher) {
1388 $dispatcher = 'Catalyst::Dispatcher';
1391 $dispatcher->require;
1394 Catalyst::Exception->throw(
1395 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1398 # dispatcher instance
1399 $class->dispatcher( $dispatcher->new );
1402 =item $c->setup_engine
1407 my ( $class, $engine ) = @_;
1410 $engine = 'Catalyst::Engine::' . $engine;
1413 if ( $ENV{CATALYST_ENGINE} ) {
1414 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1417 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1418 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1421 if ( !$engine && $ENV{MOD_PERL} ) {
1423 # create the apache method
1426 *{"$class\::apache"} = sub { shift->engine->apache };
1429 my ( $software, $version ) =
1430 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1433 $version =~ s/(\.[^.]+)\./$1/g;
1435 if ( $software eq 'mod_perl' ) {
1437 if ( $version >= 1.99922 ) {
1438 $engine = 'Catalyst::Engine::Apache2::MP20';
1441 elsif ( $version >= 1.9901 ) {
1442 $engine = 'Catalyst::Engine::Apache2::MP19';
1445 elsif ( $version >= 1.24 ) {
1446 $engine = 'Catalyst::Engine::Apache::MP13';
1450 Catalyst::Exception->throw( message =>
1451 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1454 # install the correct mod_perl handler
1455 if ( $version >= 1.9901 ) {
1456 *handler = sub : method {
1457 shift->handle_request(@_);
1461 *handler = sub ($$) { shift->handle_request(@_) };
1466 elsif ( $software eq 'Zeus-Perl' ) {
1467 $engine = 'Catalyst::Engine::Zeus';
1471 Catalyst::Exception->throw(
1472 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1477 $engine = 'Catalyst::Engine::CGI';
1483 Catalyst::Exception->throw( message =>
1484 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1488 # check for old engines that are no longer compatible
1490 if ( $engine->isa('Catalyst::Engine::Apache')
1491 && !Catalyst::Engine::Apache->VERSION )
1496 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1497 && Catalyst::Engine::Server->VERSION le '0.02' )
1502 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1503 && $engine->VERSION eq '0.01' )
1508 elsif ($engine->isa('Catalyst::Engine::Zeus')
1509 && $engine->VERSION eq '0.01' )
1515 Catalyst::Exception->throw( message =>
1516 qq/Engine "$engine" is not supported by this version of Catalyst/
1521 $class->engine( $engine->new );
1524 =item $c->setup_home
1529 my ( $class, $home ) = @_;
1531 if ( $ENV{CATALYST_HOME} ) {
1532 $home = $ENV{CATALYST_HOME};
1535 if ( $ENV{ uc($class) . '_HOME' } ) {
1536 $home = $ENV{ uc($class) . '_HOME' };
1540 $home = Catalyst::Utils::home($class);
1544 $class->config->{home} ||= $home;
1545 $class->config->{root} ||= dir($home)->subdir('root');
1554 my ( $class, $debug ) = @_;
1556 unless ( $class->log ) {
1557 $class->log( Catalyst::Log->new );
1560 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1562 *{"$class\::debug"} = sub { 1 };
1563 $class->log->debug('Debug messages enabled');
1567 =item $c->setup_plugins
1572 my ( $class, $plugins ) = @_;
1575 for my $plugin ( reverse @$plugins ) {
1577 $plugin = "Catalyst::Plugin::$plugin";
1582 Catalyst::Exception->throw(
1583 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1588 unshift @{"$class\::ISA"}, $plugin;
1593 =item $c->write( $data )
1595 Writes $data to the output stream. When using this method directly, you will
1596 need to manually set the Content-Length header to the length of your output
1604 # Finalize headers if someone manually writes output
1605 $c->finalize_headers;
1607 return $c->engine->write( $c, @_ );
1612 Returns the Catalyst version number. mostly useful for powered by messages
1613 in template systems.
1617 sub version { return $Catalyst::VERSION }
1621 =head1 INTERNAL ACTIONS
1623 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1624 C<_ACTION> and C<_END>, these are by default not shown in the private
1627 But you can deactivate this with a config parameter.
1629 MyApp->config->{show_internal_actions} = 1;
1631 =head1 CASE SENSITIVITY
1633 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1636 But you can activate case sensitivity with a config parameter.
1638 MyApp->config->{case_sensitive} = 1;
1640 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1642 =head1 ON-DEMAND PARSER
1644 The request body is usually parsed at the beginning of a request,
1645 but if you want to handle input yourself or speed things up a bit
1646 you can enable on-demand parsing with a config parameter.
1648 MyApp->config->{parse_on_demand} = 1;
1650 =head1 PROXY SUPPORT
1652 Many production servers operate using the common double-server approach, with
1653 a lightweight frontend web server passing requests to a larger backend
1654 server. An application running on the backend server must deal with two
1655 problems: the remote user always appears to be '127.0.0.1' and the server's
1656 hostname will appear to be 'localhost' regardless of the virtual host the
1657 user connected through.
1659 Catalyst will automatically detect this situation when you are running both
1660 the frontend and backend servers on the same machine. The following changes
1661 are made to the request.
1663 $c->req->address is set to the user's real IP address, as read from the
1664 HTTP_X_FORWARDED_FOR header.
1666 The host value for $c->req->base and $c->req->uri is set to the real host,
1667 as read from the HTTP_X_FORWARDED_HOST header.
1669 Obviously, your web server must support these 2 headers for this to work.
1671 In a more complex server farm environment where you may have your frontend
1672 proxy server(s) on different machines, you will need to set a configuration
1673 option to tell Catalyst to read the proxied data from the headers.
1675 MyApp->config->{using_frontend_proxy} = 1;
1677 If you do not wish to use the proxy support at all, you may set:
1679 MyApp->config->{ignore_frontend_proxy} = 1;
1681 =head1 THREAD SAFETY
1683 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1684 and the standalone forking HTTP server on Windows. We believe the Catalyst
1685 core to be thread-safe.
1687 If you plan to operate in a threaded environment, remember that all other
1688 modules you are using must also be thread-safe. Some modules, most notably
1689 DBD::SQLite, are not thread-safe.
1695 Join #catalyst on irc.perl.org.
1699 http://lists.rawmode.org/mailman/listinfo/catalyst
1700 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1704 http://catalyst.perl.org
1710 =item L<Catalyst::Manual> - The Catalyst Manual
1712 =item L<Catalyst::Engine> - Core Engine
1714 =item L<Catalyst::Log> - The Log Class.
1716 =item L<Catalyst::Request> - The Request Object
1718 =item L<Catalyst::Response> - The Response Object
1720 =item L<Catalyst::Test> - The test suite.
1784 Sebastian Riedel, C<sri@oook.de>
1788 This library is free software, you can redistribute it and/or modify it under
1789 the same terms as Perl itself.