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;
430 $match = '' if $path =~ /^\//;
433 # join args with '/', or a blank string
434 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
435 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
441 =item $c->error($error, ...)
443 =item $c->error($arrayref)
445 Returns an arrayref containing error messages.
447 my @error = @{ $c->error };
451 $c->error('Something bad happened');
462 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
463 push @{ $c->{error} }, @$error;
465 elsif ( defined $_[0] ) { $c->{error} = undef }
466 return $c->{error} || [];
471 Contains the engine instance.
472 Stringifies to the class.
476 Contains the logging object. Unless it is already set Catalyst sets this up with a
477 C<Catalyst::Log> object. To use your own log class:
479 $c->log( MyLogger->new );
480 $c->log->info("now logging with my own logger!");
482 Your log class should implement the methods described in the C<Catalyst::Log>
485 =item $c->plugin( $name, $class, @args )
487 Instant plugins for Catalyst.
488 Classdata accessor/mutator will be created, class loaded and instantiated.
490 MyApp->plugin( 'prototype', 'HTML::Prototype' );
492 $c->prototype->define_javascript_functions;
497 my ( $class, $name, $plugin, @args ) = @_;
500 if ( my $error = $UNIVERSAL::require::ERROR ) {
501 Catalyst::Exception->throw(
502 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
505 eval { $plugin->import };
506 $class->mk_classdata($name);
508 eval { $obj = $plugin->new(@args) };
511 Catalyst::Exception->throw( message =>
512 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
516 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
524 Returns a C<Catalyst::Request> object.
532 Returns a C<Catalyst::Response> object.
538 Contains the return value of the last executed action.
542 Returns a hashref containing all your data.
544 print $c->stash->{foo};
546 Keys may be set in the stash by assigning to the hash reference, or by passing
547 either a single hash reference or a list of key/value pairs as arguments.
551 $c->stash->{foo} ||= 'yada';
552 $c->stash( { moose => 'majestic', qux => 0 } );
553 $c->stash( bar => 1, gorch => 2 );
560 my $stash = @_ > 1 ? {@_} : $_[0];
561 while ( my ( $key, $val ) = each %$stash ) {
562 $c->{stash}->{$key} = $val;
568 =item $c->welcome_message
570 Returns the Catalyst welcome HTML page.
574 sub welcome_message {
576 my $name = $c->config->{name};
577 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
578 my $prefix = Catalyst::Utils::appprefix( ref $c );
582 <title>$name on Catalyst $VERSION</title>
583 <style type="text/css">
588 background-color: #eee;
596 background-color: #ccc;
597 border: 1px solid #aaa;
598 -moz-border-radius: 10px;
603 font-family: verdana, tahoma, sans-serif;
606 font-family: verdana, tahoma, sans-serif;
609 text-decoration: none;
611 border-bottom: 1px dotted #bbb;
613 :link:hover, :visited:hover {
626 background-color: #fff;
627 border: 1px solid #aaa;
628 -moz-border-radius: 10px;
653 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
660 <p>Welcome to the wonderful world of Catalyst.
661 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
662 framework will make web development something you had
663 never expected it to be: Fun, rewarding and quick.</p>
664 <h2>What to do now?</h2>
665 <p>That really depends on what <b>you</b> want to do.
666 We do, however, provide you with a few starting points.</p>
667 <p>If you want to jump right into web development with Catalyst
668 you might want to check out the documentation.</p>
669 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
670 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
671 <h2>What to do next?</h2>
672 <p>Next it's time to write an actual application. Use the
673 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
674 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
675 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
676 they can save you a lot of work.</p>
677 <pre><code>script/${prefix}_create.pl -help</code></pre>
678 <p>Also, be sure to check out the vast and growing
679 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
680 you are likely to find what you need there.
684 <p>Catalyst has a very active community. Here are the main places to
685 get in touch with us.</p>
688 <a href="http://dev.catalyst.perl.org">Wiki</a>
691 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
694 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
697 <h2>In conclusion</h2>
698 <p>The Catalyst team hopes you will enjoy using Catalyst as much
699 as we enjoyed making it. Please contact us if you have ideas
700 for improvement or other feedback.</p>
710 =head1 INTERNAL METHODS
714 =item $c->benchmark($coderef)
716 Takes a coderef with arguments and returns elapsed time as float.
718 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
719 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
726 my $time = [gettimeofday];
727 my @return = &$code(@_);
728 my $elapsed = tv_interval $time;
729 return wantarray ? ( $elapsed, @return ) : $elapsed;
734 Contains the components.
738 Returns a hashref containing coderefs and execution counts.
739 (Needed for deep recursion detection)
743 Returns the actual forward depth.
747 Dispatch request to actions.
751 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
755 Returns a list of 2-element array references (name, structure) pairs that will
756 be dumped on the error page in debug mode.
762 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
765 =item $c->execute($class, $coderef)
767 Execute a coderef in given class and catch exceptions.
768 Errors are available via $c->error.
773 my ( $c, $class, $code ) = @_;
774 $class = $c->components->{$class} || $class;
776 my $callsub = ( caller(1) )[3];
781 $action = "/$action" unless $action =~ /\-\>/;
782 $c->counter->{"$code"}++;
784 if ( $c->counter->{"$code"} > $RECURSION ) {
785 my $error = qq/Deep recursion detected in "$action"/;
786 $c->log->error($error);
792 $action = "-> $action" if $callsub =~ /forward$/;
798 my ( $elapsed, @state ) =
799 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
800 unless ( ( $code->name =~ /^_.*/ )
801 && ( !$c->config->{show_internal_actions} ) )
803 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
808 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
813 if ( my $error = $@ ) {
815 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
817 unless ( ref $error ) {
819 $error = qq/Caught exception "$error"/;
822 $c->log->error($error);
839 $c->finalize_uploads;
842 if ( $#{ $c->error } >= 0 ) {
846 $c->finalize_headers;
849 if ( $c->request->method eq 'HEAD' ) {
850 $c->response->body('');
855 return $c->response->status;
858 =item $c->finalize_body
864 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
866 =item $c->finalize_cookies
872 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
874 =item $c->finalize_error
880 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
882 =item $c->finalize_headers
888 sub finalize_headers {
891 # Check if we already finalized headers
892 return if $c->response->{_finalized_headers};
895 if ( my $location = $c->response->redirect ) {
896 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
897 $c->response->header( Location => $location );
901 if ( $c->response->body && !$c->response->content_length ) {
902 $c->response->content_length( bytes::length( $c->response->body ) );
906 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
907 $c->response->headers->remove_header("Content-Length");
908 $c->response->body('');
911 $c->finalize_cookies;
913 $c->engine->finalize_headers( $c, @_ );
916 $c->response->{_finalized_headers} = 1;
919 =item $c->finalize_output
921 An alias for finalize_body.
923 =item $c->finalize_read
925 Finalize the input after reading is complete.
929 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
931 =item $c->finalize_uploads
933 Finalize uploads. Cleans up any temporary files.
937 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
939 =item $c->get_action( $action, $namespace )
941 Get an action in a given namespace.
945 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
947 =item $c->get_actions( $action, $namespace )
949 Get all actions of a given name in a namespace and all base namespaces.
953 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
955 =item handle_request( $class, @arguments )
962 my ( $class, @arguments ) = @_;
964 # Always expect worst case!
970 my $c = $class->prepare(@arguments);
971 $c->{stats} = \@stats;
976 if ( $class->debug ) {
978 ( $elapsed, $status ) = $class->benchmark($handler);
979 $elapsed = sprintf '%f', $elapsed;
980 my $av = sprintf '%.3f',
981 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
982 my $t = Text::ASCIITable->new;
983 $t->setCols( 'Action', 'Time' );
984 $t->setColWidth( 'Action', 64, 1 );
985 $t->setColWidth( 'Time', 9, 1 );
987 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
989 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
991 else { $status = &$handler }
995 if ( my $error = $@ ) {
997 $class->log->error(qq/Caught exception in engine "$error"/);
1001 $class->log->_flush() if $class->log->can('_flush');
1005 =item $c->prepare(@arguments)
1007 Turns the engine-specific request( Apache, CGI ... )
1008 into a Catalyst context .
1013 my ( $class, @arguments ) = @_;
1018 request => Catalyst::Request->new(
1021 body_parameters => {},
1023 headers => HTTP::Headers->new,
1025 query_parameters => {},
1031 response => Catalyst::Response->new(
1035 headers => HTTP::Headers->new(),
1043 # For on-demand data
1044 $c->request->{_context} = $c;
1045 $c->response->{_context} = $c;
1046 weaken( $c->request->{_context} );
1047 weaken( $c->response->{_context} );
1050 my $secs = time - $START || 1;
1051 my $av = sprintf '%.3f', $COUNT / $secs;
1052 $c->log->debug('**********************************');
1053 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1054 $c->log->debug('**********************************');
1055 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1058 $c->prepare_request(@arguments);
1059 $c->prepare_connection;
1060 $c->prepare_query_parameters;
1061 $c->prepare_headers;
1062 $c->prepare_cookies;
1066 $c->prepare_body unless $c->config->{parse_on_demand};
1069 my $method = $c->req->method || '';
1070 my $path = $c->req->path || '';
1071 my $address = $c->req->address || '';
1073 $c->log->debug(qq/"$method" request for "$path" from $address/)
1079 =item $c->prepare_action
1085 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1087 =item $c->prepare_body
1089 Prepare message body.
1096 # Do we run for the first time?
1097 return if defined $c->request->{_body};
1099 # Initialize on-demand data
1100 $c->engine->prepare_body( $c, @_ );
1101 $c->prepare_parameters;
1102 $c->prepare_uploads;
1104 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1105 my $t = Text::ASCIITable->new;
1106 $t->setCols( 'Key', 'Value' );
1107 $t->setColWidth( 'Key', 37, 1 );
1108 $t->setColWidth( 'Value', 36, 1 );
1109 $t->alignCol( 'Value', 'right' );
1110 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1111 my $param = $c->req->body_parameters->{$key};
1112 my $value = defined($param) ? $param : '';
1114 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1116 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1120 =item $c->prepare_body_chunk( $chunk )
1122 Prepare a chunk of data before sending it to HTTP::Body.
1126 sub prepare_body_chunk {
1128 $c->engine->prepare_body_chunk( $c, @_ );
1131 =item $c->prepare_body_parameters
1133 Prepare body parameters.
1137 sub prepare_body_parameters {
1139 $c->engine->prepare_body_parameters( $c, @_ );
1142 =item $c->prepare_connection
1148 sub prepare_connection {
1150 $c->engine->prepare_connection( $c, @_ );
1153 =item $c->prepare_cookies
1159 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1161 =item $c->prepare_headers
1167 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1169 =item $c->prepare_parameters
1175 sub prepare_parameters {
1177 $c->prepare_body_parameters;
1178 $c->engine->prepare_parameters( $c, @_ );
1181 =item $c->prepare_path
1183 Prepare path and base.
1187 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1189 =item $c->prepare_query_parameters
1191 Prepare query parameters.
1195 sub prepare_query_parameters {
1198 $c->engine->prepare_query_parameters( $c, @_ );
1200 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1201 my $t = Text::ASCIITable->new;
1202 $t->setCols( 'Key', 'Value' );
1203 $t->setColWidth( 'Key', 37, 1 );
1204 $t->setColWidth( 'Value', 36, 1 );
1205 $t->alignCol( 'Value', 'right' );
1206 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1207 my $param = $c->req->query_parameters->{$key};
1208 my $value = defined($param) ? $param : '';
1210 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1212 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1216 =item $c->prepare_read
1218 Prepare the input for reading.
1222 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1224 =item $c->prepare_request
1226 Prepare the engine request.
1230 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1232 =item $c->prepare_uploads
1238 sub prepare_uploads {
1241 $c->engine->prepare_uploads( $c, @_ );
1243 if ( $c->debug && keys %{ $c->request->uploads } ) {
1244 my $t = Text::ASCIITable->new;
1245 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1246 $t->setColWidth( 'Key', 12, 1 );
1247 $t->setColWidth( 'Filename', 28, 1 );
1248 $t->setColWidth( 'Type', 18, 1 );
1249 $t->setColWidth( 'Size', 9, 1 );
1250 $t->alignCol( 'Size', 'left' );
1251 for my $key ( sort keys %{ $c->request->uploads } ) {
1252 my $upload = $c->request->uploads->{$key};
1253 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1254 $t->addRow( $key, $u->filename, $u->type, $u->size );
1257 $c->log->debug( "File Uploads are:\n" . $t->draw );
1261 =item $c->prepare_write
1263 Prepare the output for writing.
1267 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1269 =item $c->read( [$maxlength] )
1271 Read a chunk of data from the request body. This method is designed to be
1272 used in a while loop, reading $maxlength bytes on every call. $maxlength
1273 defaults to the size of the request if not specified.
1275 You have to set MyApp->config->{parse_on_demand} to use this directly.
1279 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1287 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1289 =item $c->set_action( $action, $code, $namespace, $attrs )
1291 Set an action in a given namespace.
1295 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1297 =item $c->setup_actions($component)
1299 Setup actions for a component.
1303 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1305 =item $c->setup_components
1311 sub setup_components {
1314 my $callback = sub {
1315 my ( $component, $context ) = @_;
1317 unless ( $component->isa('Catalyst::Base') ) {
1321 my $suffix = Catalyst::Utils::class2classsuffix($component);
1322 my $config = $class->config->{$suffix} || {};
1326 eval { $instance = $component->new( $context, $config ); };
1328 if ( my $error = $@ ) {
1332 Catalyst::Exception->throw( message =>
1333 qq/Couldn't instantiate component "$component", "$error"/ );
1336 Catalyst::Exception->throw( message =>
1337 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1339 unless ref $instance;
1344 Module::Pluggable::Fast->import(
1345 name => '_catalyst_components',
1347 "$class\::Controller", "$class\::C",
1348 "$class\::Model", "$class\::M",
1349 "$class\::View", "$class\::V"
1351 callback => $callback
1355 if ( my $error = $@ ) {
1359 Catalyst::Exception->throw(
1360 message => qq/Couldn't load components "$error"/ );
1363 for my $component ( $class->_catalyst_components($class) ) {
1364 $class->components->{ ref $component || $component } = $component;
1368 =item $c->setup_dispatcher
1372 sub setup_dispatcher {
1373 my ( $class, $dispatcher ) = @_;
1376 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1379 if ( $ENV{CATALYST_DISPATCHER} ) {
1380 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1383 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1385 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1388 unless ($dispatcher) {
1389 $dispatcher = 'Catalyst::Dispatcher';
1392 $dispatcher->require;
1395 Catalyst::Exception->throw(
1396 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1399 # dispatcher instance
1400 $class->dispatcher( $dispatcher->new );
1403 =item $c->setup_engine
1408 my ( $class, $engine ) = @_;
1411 $engine = 'Catalyst::Engine::' . $engine;
1414 if ( $ENV{CATALYST_ENGINE} ) {
1415 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1418 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1419 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1422 if ( !$engine && $ENV{MOD_PERL} ) {
1424 # create the apache method
1427 *{"$class\::apache"} = sub { shift->engine->apache };
1430 my ( $software, $version ) =
1431 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1434 $version =~ s/(\.[^.]+)\./$1/g;
1436 if ( $software eq 'mod_perl' ) {
1438 if ( $version >= 1.99922 ) {
1439 $engine = 'Catalyst::Engine::Apache2::MP20';
1442 elsif ( $version >= 1.9901 ) {
1443 $engine = 'Catalyst::Engine::Apache2::MP19';
1446 elsif ( $version >= 1.24 ) {
1447 $engine = 'Catalyst::Engine::Apache::MP13';
1451 Catalyst::Exception->throw( message =>
1452 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1455 # install the correct mod_perl handler
1456 if ( $version >= 1.9901 ) {
1457 *handler = sub : method {
1458 shift->handle_request(@_);
1462 *handler = sub ($$) { shift->handle_request(@_) };
1467 elsif ( $software eq 'Zeus-Perl' ) {
1468 $engine = 'Catalyst::Engine::Zeus';
1472 Catalyst::Exception->throw(
1473 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1478 $engine = 'Catalyst::Engine::CGI';
1484 Catalyst::Exception->throw( message =>
1485 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1489 # check for old engines that are no longer compatible
1491 if ( $engine->isa('Catalyst::Engine::Apache')
1492 && !Catalyst::Engine::Apache->VERSION )
1497 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1498 && Catalyst::Engine::Server->VERSION le '0.02' )
1503 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1504 && $engine->VERSION eq '0.01' )
1509 elsif ($engine->isa('Catalyst::Engine::Zeus')
1510 && $engine->VERSION eq '0.01' )
1516 Catalyst::Exception->throw( message =>
1517 qq/Engine "$engine" is not supported by this version of Catalyst/
1522 $class->engine( $engine->new );
1525 =item $c->setup_home
1530 my ( $class, $home ) = @_;
1532 if ( $ENV{CATALYST_HOME} ) {
1533 $home = $ENV{CATALYST_HOME};
1536 if ( $ENV{ uc($class) . '_HOME' } ) {
1537 $home = $ENV{ uc($class) . '_HOME' };
1541 $home = Catalyst::Utils::home($class);
1545 $class->config->{home} ||= $home;
1546 $class->config->{root} ||= dir($home)->subdir('root');
1555 my ( $class, $debug ) = @_;
1557 unless ( $class->log ) {
1558 $class->log( Catalyst::Log->new );
1561 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1563 *{"$class\::debug"} = sub { 1 };
1564 $class->log->debug('Debug messages enabled');
1568 =item $c->setup_plugins
1573 my ( $class, $plugins ) = @_;
1576 for my $plugin ( reverse @$plugins ) {
1578 $plugin = "Catalyst::Plugin::$plugin";
1583 Catalyst::Exception->throw(
1584 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1589 unshift @{"$class\::ISA"}, $plugin;
1594 =item $c->write( $data )
1596 Writes $data to the output stream. When using this method directly, you will
1597 need to manually set the Content-Length header to the length of your output
1605 # Finalize headers if someone manually writes output
1606 $c->finalize_headers;
1608 return $c->engine->write( $c, @_ );
1613 Returns the Catalyst version number. mostly useful for powered by messages
1614 in template systems.
1618 sub version { return $Catalyst::VERSION }
1622 =head1 INTERNAL ACTIONS
1624 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1625 C<_ACTION> and C<_END>, these are by default not shown in the private
1628 But you can deactivate this with a config parameter.
1630 MyApp->config->{show_internal_actions} = 1;
1632 =head1 CASE SENSITIVITY
1634 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1637 But you can activate case sensitivity with a config parameter.
1639 MyApp->config->{case_sensitive} = 1;
1641 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1643 =head1 ON-DEMAND PARSER
1645 The request body is usually parsed at the beginning of a request,
1646 but if you want to handle input yourself or speed things up a bit
1647 you can enable on-demand parsing with a config parameter.
1649 MyApp->config->{parse_on_demand} = 1;
1651 =head1 PROXY SUPPORT
1653 Many production servers operate using the common double-server approach, with
1654 a lightweight frontend web server passing requests to a larger backend
1655 server. An application running on the backend server must deal with two
1656 problems: the remote user always appears to be '127.0.0.1' and the server's
1657 hostname will appear to be 'localhost' regardless of the virtual host the
1658 user connected through.
1660 Catalyst will automatically detect this situation when you are running both
1661 the frontend and backend servers on the same machine. The following changes
1662 are made to the request.
1664 $c->req->address is set to the user's real IP address, as read from the
1665 HTTP_X_FORWARDED_FOR header.
1667 The host value for $c->req->base and $c->req->uri is set to the real host,
1668 as read from the HTTP_X_FORWARDED_HOST header.
1670 Obviously, your web server must support these 2 headers for this to work.
1672 In a more complex server farm environment where you may have your frontend
1673 proxy server(s) on different machines, you will need to set a configuration
1674 option to tell Catalyst to read the proxied data from the headers.
1676 MyApp->config->{using_frontend_proxy} = 1;
1678 If you do not wish to use the proxy support at all, you may set:
1680 MyApp->config->{ignore_frontend_proxy} = 1;
1682 =head1 THREAD SAFETY
1684 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1685 and the standalone forking HTTP server on Windows. We believe the Catalyst
1686 core to be thread-safe.
1688 If you plan to operate in a threaded environment, remember that all other
1689 modules you are using must also be thread-safe. Some modules, most notably
1690 DBD::SQLite, are not thread-safe.
1696 Join #catalyst on irc.perl.org.
1700 http://lists.rawmode.org/mailman/listinfo/catalyst
1701 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1705 http://catalyst.perl.org
1711 =item L<Catalyst::Manual> - The Catalyst Manual
1713 =item L<Catalyst::Engine> - Core Engine
1715 =item L<Catalyst::Log> - The Log Class.
1717 =item L<Catalyst::Request> - The Request Object
1719 =item L<Catalyst::Response> - The Response Object
1721 =item L<Catalyst::Test> - The test suite.
1785 Sebastian Riedel, C<sri@oook.de>
1789 This library is free software, you can redistribute it and/or modify it under
1790 the same terms as Perl itself.