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/;
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 = 10;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_03';
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::SimpleTable->new(76);
352 $t->row($_) for @plugins;
353 $class->log->debug( "Loaded plugins:\n" . $t->draw );
356 my $dispatcher = $class->dispatcher;
357 my $engine = $class->engine;
358 my $home = $class->config->{home};
360 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
361 $class->log->debug(qq/Loaded engine "$engine"/);
365 ? $class->log->debug(qq/Found home "$home"/)
366 : $class->log->debug(qq/Home "$home" doesn't exist/)
367 : $class->log->debug(q/Couldn't find home/);
372 no warnings qw/redefine/;
373 local *setup = sub { };
377 # Initialize our data structure
378 $class->components( {} );
380 $class->setup_components;
382 if ( $class->debug ) {
383 my $t = Text::SimpleTable->new(76);
384 $t->row($_) for sort keys %{ $class->components };
385 $class->log->debug( "Loaded components:\n" . $t->draw )
386 if ( keys %{ $class->components } );
389 # Add our self to components, since we are also a component
390 $class->components->{$class} = $class;
392 $class->setup_actions;
394 if ( $class->debug ) {
395 my $name = $class->config->{name} || 'Application';
396 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
398 $class->log->_flush() if $class->log->can('_flush');
401 =item $c->uri_for($path,[@args])
403 Merges path with $c->request->base for absolute uri's and with
404 $c->request->match for relative uri's, then returns a normalized
405 L<URI> object. If any args are passed, they are added at the end
411 my ( $c, $path, @args ) = @_;
412 my $base = $c->request->base->clone;
413 my $basepath = $base->path;
414 $basepath =~ s/\/$//;
416 my $match = $c->request->match;
418 # massage match, empty if absolute path
420 $match .= '/' if $match;
422 $match = '' if $path =~ /^\//;
425 # join args with '/', or a blank string
426 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
427 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
433 =item $c->error($error, ...)
435 =item $c->error($arrayref)
437 Returns an arrayref containing error messages.
439 my @error = @{ $c->error };
443 $c->error('Something bad happened');
454 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
455 push @{ $c->{error} }, @$error;
457 elsif ( defined $_[0] ) { $c->{error} = undef }
458 return $c->{error} || [];
463 Contains the engine instance.
464 Stringifies to the class.
468 Contains the logging object. Unless it is already set Catalyst sets this up with a
469 C<Catalyst::Log> object. To use your own log class:
471 $c->log( MyLogger->new );
472 $c->log->info("now logging with my own logger!");
474 Your log class should implement the methods described in the C<Catalyst::Log>
477 =item $c->plugin( $name, $class, @args )
479 Instant plugins for Catalyst.
480 Classdata accessor/mutator will be created, class loaded and instantiated.
482 MyApp->plugin( 'prototype', 'HTML::Prototype' );
484 $c->prototype->define_javascript_functions;
489 my ( $class, $name, $plugin, @args ) = @_;
492 if ( my $error = $UNIVERSAL::require::ERROR ) {
493 Catalyst::Exception->throw(
494 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
497 eval { $plugin->import };
498 $class->mk_classdata($name);
500 eval { $obj = $plugin->new(@args) };
503 Catalyst::Exception->throw( message =>
504 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
508 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
516 Returns a C<Catalyst::Request> object.
524 Returns a C<Catalyst::Response> object.
530 Contains the return value of the last executed action.
534 Returns a hashref containing all your data.
536 print $c->stash->{foo};
538 Keys may be set in the stash by assigning to the hash reference, or by passing
539 either a single hash reference or a list of key/value pairs as arguments.
543 $c->stash->{foo} ||= 'yada';
544 $c->stash( { moose => 'majestic', qux => 0 } );
545 $c->stash( bar => 1, gorch => 2 );
552 my $stash = @_ > 1 ? {@_} : $_[0];
553 while ( my ( $key, $val ) = each %$stash ) {
554 $c->{stash}->{$key} = $val;
560 =item $c->welcome_message
562 Returns the Catalyst welcome HTML page.
566 sub welcome_message {
568 my $name = $c->config->{name};
569 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
570 my $prefix = Catalyst::Utils::appprefix( ref $c );
571 $c->response->content_type('text/html; charset=utf-8');
573 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
574 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
575 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
577 <meta http-equiv="Content-Language" content="en" />
578 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
579 <title>$name on Catalyst $VERSION</title>
580 <style type="text/css">
583 background-color: #eee;
592 background-color: #ccc;
593 border: 1px solid #aaa;
594 -moz-border-radius: 10px;
599 font-family: verdana, tahoma, sans-serif;
602 font-family: verdana, tahoma, sans-serif;
605 text-decoration: none;
607 border-bottom: 1px dotted #bbb;
609 :link:hover, :visited:hover {
622 background-color: #fff;
623 border: 1px solid #aaa;
624 -moz-border-radius: 10px;
650 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
655 <img src="$logo" alt="Catalyst Logo" />
657 <p>Welcome to the wonderful world of Catalyst.
658 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
659 framework will make web development something you had
660 never expected it to be: Fun, rewarding and quick.</p>
661 <h2>What to do now?</h2>
662 <p>That really depends on what <b>you</b> want to do.
663 We do, however, provide you with a few starting points.</p>
664 <p>If you want to jump right into web development with Catalyst
665 you might want to check out the documentation.</p>
666 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
667 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
668 <h2>What to do next?</h2>
669 <p>Next it's time to write an actual application. Use the
670 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
671 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
672 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
673 they can save you a lot of work.</p>
674 <pre><code>script/${prefix}_create.pl -help</code></pre>
675 <p>Also, be sure to check out the vast and growing
676 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
677 you are likely to find what you need there.
681 <p>Catalyst has a very active community. Here are the main places to
682 get in touch with us.</p>
685 <a href="http://dev.catalyst.perl.org">Wiki</a>
688 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
691 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
694 <h2>In conclusion</h2>
695 <p>The Catalyst team hopes you will enjoy using Catalyst as much
696 as we enjoyed making it. Please contact us if you have ideas
697 for improvement or other feedback.</p>
707 =head1 INTERNAL METHODS
711 =item $c->benchmark($coderef)
713 Takes a coderef with arguments and returns elapsed time as float.
715 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
716 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
723 my $time = [gettimeofday];
724 my @return = &$code(@_);
725 my $elapsed = tv_interval $time;
726 return wantarray ? ( $elapsed, @return ) : $elapsed;
731 Contains the components.
735 Returns a hashref containing coderefs and execution counts.
736 (Needed for deep recursion detection)
740 Returns the actual forward depth.
744 Dispatch request to actions.
748 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
752 Returns a list of 2-element array references (name, structure) pairs that will
753 be dumped on the error page in debug mode.
759 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
762 =item $c->execute($class, $coderef)
764 Execute a coderef in given class and catch exceptions.
765 Errors are available via $c->error.
770 my ( $c, $class, $code ) = @_;
771 $class = $c->components->{$class} || $class;
773 my $callsub = ( caller(1) )[3];
778 $action = "/$action" unless $action =~ /\-\>/;
779 $c->counter->{"$code"}++;
781 if ( $c->counter->{"$code"} > $RECURSION ) {
782 my $error = qq/Deep recursion detected in "$action"/;
783 $c->log->error($error);
789 $action = "-> $action" if $callsub =~ /forward$/;
795 my ( $elapsed, @state ) =
796 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
797 unless ( ( $code->name =~ /^_.*/ )
798 && ( !$c->config->{show_internal_actions} ) )
800 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
805 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
810 if ( my $error = $@ ) {
812 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
814 unless ( ref $error ) {
816 $error = qq/Caught exception "$error"/;
819 $c->log->error($error);
836 $c->finalize_uploads;
839 if ( $#{ $c->error } >= 0 ) {
843 $c->finalize_headers;
846 if ( $c->request->method eq 'HEAD' ) {
847 $c->response->body('');
852 return $c->response->status;
855 =item $c->finalize_body
861 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
863 =item $c->finalize_cookies
869 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
871 =item $c->finalize_error
877 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
879 =item $c->finalize_headers
885 sub finalize_headers {
888 # Check if we already finalized headers
889 return if $c->response->{_finalized_headers};
892 if ( my $location = $c->response->redirect ) {
893 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
894 $c->response->header( Location => $location );
898 if ( $c->response->body && !$c->response->content_length ) {
899 $c->response->content_length( bytes::length( $c->response->body ) );
903 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
904 $c->response->headers->remove_header("Content-Length");
905 $c->response->body('');
908 $c->finalize_cookies;
910 $c->engine->finalize_headers( $c, @_ );
913 $c->response->{_finalized_headers} = 1;
916 =item $c->finalize_output
918 An alias for finalize_body.
920 =item $c->finalize_read
922 Finalize the input after reading is complete.
926 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
928 =item $c->finalize_uploads
930 Finalize uploads. Cleans up any temporary files.
934 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
936 =item $c->get_action( $action, $namespace )
938 Get an action in a given namespace.
942 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
944 =item $c->get_actions( $action, $namespace )
946 Get all actions of a given name in a namespace and all base namespaces.
950 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
952 =item handle_request( $class, @arguments )
959 my ( $class, @arguments ) = @_;
961 # Always expect worst case!
967 my $c = $class->prepare(@arguments);
968 $c->{stats} = \@stats;
973 if ( $class->debug ) {
975 ( $elapsed, $status ) = $class->benchmark($handler);
976 $elapsed = sprintf '%f', $elapsed;
977 my $av = sprintf '%.3f',
978 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
979 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
981 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
983 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
985 else { $status = &$handler }
989 if ( my $error = $@ ) {
991 $class->log->error(qq/Caught exception in engine "$error"/);
995 $class->log->_flush() if $class->log->can('_flush');
999 =item $c->prepare(@arguments)
1001 Turns the engine-specific request( Apache, CGI ... )
1002 into a Catalyst context .
1007 my ( $class, @arguments ) = @_;
1012 request => Catalyst::Request->new(
1015 body_parameters => {},
1017 headers => HTTP::Headers->new,
1019 query_parameters => {},
1025 response => Catalyst::Response->new(
1029 headers => HTTP::Headers->new(),
1037 # For on-demand data
1038 $c->request->{_context} = $c;
1039 $c->response->{_context} = $c;
1040 weaken( $c->request->{_context} );
1041 weaken( $c->response->{_context} );
1044 my $secs = time - $START || 1;
1045 my $av = sprintf '%.3f', $COUNT / $secs;
1046 $c->log->debug('**********************************');
1047 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1048 $c->log->debug('**********************************');
1049 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1052 $c->prepare_request(@arguments);
1053 $c->prepare_connection;
1054 $c->prepare_query_parameters;
1055 $c->prepare_headers;
1056 $c->prepare_cookies;
1060 $c->prepare_body unless $c->config->{parse_on_demand};
1063 my $method = $c->req->method || '';
1064 my $path = $c->req->path || '';
1065 my $address = $c->req->address || '';
1067 $c->log->debug(qq/"$method" request for "$path" from $address/)
1073 =item $c->prepare_action
1079 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1081 =item $c->prepare_body
1083 Prepare message body.
1090 # Do we run for the first time?
1091 return if defined $c->request->{_body};
1093 # Initialize on-demand data
1094 $c->engine->prepare_body( $c, @_ );
1095 $c->prepare_parameters;
1096 $c->prepare_uploads;
1098 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1099 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1100 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1101 my $param = $c->req->body_parameters->{$key};
1102 my $value = defined($param) ? $param : '';
1104 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1106 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1110 =item $c->prepare_body_chunk( $chunk )
1112 Prepare a chunk of data before sending it to HTTP::Body.
1116 sub prepare_body_chunk {
1118 $c->engine->prepare_body_chunk( $c, @_ );
1121 =item $c->prepare_body_parameters
1123 Prepare body parameters.
1127 sub prepare_body_parameters {
1129 $c->engine->prepare_body_parameters( $c, @_ );
1132 =item $c->prepare_connection
1138 sub prepare_connection {
1140 $c->engine->prepare_connection( $c, @_ );
1143 =item $c->prepare_cookies
1149 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1151 =item $c->prepare_headers
1157 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1159 =item $c->prepare_parameters
1165 sub prepare_parameters {
1167 $c->prepare_body_parameters;
1168 $c->engine->prepare_parameters( $c, @_ );
1171 =item $c->prepare_path
1173 Prepare path and base.
1177 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1179 =item $c->prepare_query_parameters
1181 Prepare query parameters.
1185 sub prepare_query_parameters {
1188 $c->engine->prepare_query_parameters( $c, @_ );
1190 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1191 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1192 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1193 my $param = $c->req->query_parameters->{$key};
1194 my $value = defined($param) ? $param : '';
1196 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1198 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1202 =item $c->prepare_read
1204 Prepare the input for reading.
1208 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1210 =item $c->prepare_request
1212 Prepare the engine request.
1216 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1218 =item $c->prepare_uploads
1224 sub prepare_uploads {
1227 $c->engine->prepare_uploads( $c, @_ );
1229 if ( $c->debug && keys %{ $c->request->uploads } ) {
1230 my $t = Text::SimpleTable->new(
1236 for my $key ( sort keys %{ $c->request->uploads } ) {
1237 my $upload = $c->request->uploads->{$key};
1238 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1239 $t->row( $key, $u->filename, $u->type, $u->size );
1242 $c->log->debug( "File Uploads are:\n" . $t->draw );
1246 =item $c->prepare_write
1248 Prepare the output for writing.
1252 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1254 =item $c->read( [$maxlength] )
1256 Read a chunk of data from the request body. This method is designed to be
1257 used in a while loop, reading $maxlength bytes on every call. $maxlength
1258 defaults to the size of the request if not specified.
1260 You have to set MyApp->config->{parse_on_demand} to use this directly.
1264 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1272 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1274 =item $c->set_action( $action, $code, $namespace, $attrs )
1276 Set an action in a given namespace.
1280 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1282 =item $c->setup_actions($component)
1284 Setup actions for a component.
1288 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1290 =item $c->setup_components
1296 sub setup_components {
1299 my $callback = sub {
1300 my ( $component, $context ) = @_;
1302 unless ( $component->isa('Catalyst::Base') ) {
1306 my $suffix = Catalyst::Utils::class2classsuffix($class);
1307 my $config = $class->config->{$suffix} || {};
1311 eval { $instance = $component->new( $context, $config ); };
1313 if ( my $error = $@ ) {
1317 Catalyst::Exception->throw( message =>
1318 qq/Couldn't instantiate component "$component", "$error"/ );
1321 Catalyst::Exception->throw( message =>
1322 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1324 unless ref $instance;
1329 Module::Pluggable::Fast->import(
1330 name => '_catalyst_components',
1332 "$class\::Controller", "$class\::C",
1333 "$class\::Model", "$class\::M",
1334 "$class\::View", "$class\::V"
1336 callback => $callback
1340 if ( my $error = $@ ) {
1344 Catalyst::Exception->throw(
1345 message => qq/Couldn't load components "$error"/ );
1348 for my $component ( $class->_catalyst_components($class) ) {
1349 $class->components->{ ref $component || $component } = $component;
1353 =item $c->setup_dispatcher
1357 sub setup_dispatcher {
1358 my ( $class, $dispatcher ) = @_;
1361 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1364 if ( $ENV{CATALYST_DISPATCHER} ) {
1365 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1368 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1370 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1373 unless ($dispatcher) {
1374 $dispatcher = 'Catalyst::Dispatcher';
1377 $dispatcher->require;
1380 Catalyst::Exception->throw(
1381 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1384 # dispatcher instance
1385 $class->dispatcher( $dispatcher->new );
1388 =item $c->setup_engine
1393 my ( $class, $engine ) = @_;
1396 $engine = 'Catalyst::Engine::' . $engine;
1399 if ( $ENV{CATALYST_ENGINE} ) {
1400 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1403 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1404 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1407 if ( !$engine && $ENV{MOD_PERL} ) {
1409 # create the apache method
1412 *{"$class\::apache"} = sub { shift->engine->apache };
1415 my ( $software, $version ) =
1416 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1419 $version =~ s/(\.[^.]+)\./$1/g;
1421 if ( $software eq 'mod_perl' ) {
1423 if ( $version >= 1.99922 ) {
1424 $engine = 'Catalyst::Engine::Apache2::MP20';
1427 elsif ( $version >= 1.9901 ) {
1428 $engine = 'Catalyst::Engine::Apache2::MP19';
1431 elsif ( $version >= 1.24 ) {
1432 $engine = 'Catalyst::Engine::Apache::MP13';
1436 Catalyst::Exception->throw( message =>
1437 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1440 # install the correct mod_perl handler
1441 if ( $version >= 1.9901 ) {
1442 *handler = sub : method {
1443 shift->handle_request(@_);
1447 *handler = sub ($$) { shift->handle_request(@_) };
1452 elsif ( $software eq 'Zeus-Perl' ) {
1453 $engine = 'Catalyst::Engine::Zeus';
1457 Catalyst::Exception->throw(
1458 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1463 $engine = 'Catalyst::Engine::CGI';
1469 Catalyst::Exception->throw( message =>
1470 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1474 # check for old engines that are no longer compatible
1476 if ( $engine->isa('Catalyst::Engine::Apache')
1477 && !Catalyst::Engine::Apache->VERSION )
1482 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1483 && Catalyst::Engine::Server->VERSION le '0.02' )
1488 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1489 && $engine->VERSION eq '0.01' )
1494 elsif ($engine->isa('Catalyst::Engine::Zeus')
1495 && $engine->VERSION eq '0.01' )
1501 Catalyst::Exception->throw( message =>
1502 qq/Engine "$engine" is not supported by this version of Catalyst/
1507 $class->engine( $engine->new );
1510 =item $c->setup_home
1515 my ( $class, $home ) = @_;
1517 if ( $ENV{CATALYST_HOME} ) {
1518 $home = $ENV{CATALYST_HOME};
1521 if ( $ENV{ uc($class) . '_HOME' } ) {
1522 $home = $ENV{ uc($class) . '_HOME' };
1526 $home = Catalyst::Utils::home($class);
1530 $class->config->{home} ||= $home;
1531 $class->config->{root} ||= dir($home)->subdir('root');
1540 my ( $class, $debug ) = @_;
1542 unless ( $class->log ) {
1543 $class->log( Catalyst::Log->new );
1546 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1548 if ( ( defined( $ENV{CATALYST_DEBUG} ) ||
1549 defined( $ENV{ $app_flag } ) ) ?
1550 ( $ENV{CATALYST_DEBUG} || $ENV{ $app_flag } ) :
1553 *{"$class\::debug"} = sub { 1 };
1554 $class->log->debug('Debug messages enabled');
1558 =item $c->setup_plugins
1563 my ( $class, $plugins ) = @_;
1566 for my $plugin ( reverse @$plugins ) {
1568 $plugin = "Catalyst::Plugin::$plugin";
1573 Catalyst::Exception->throw(
1574 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1579 unshift @{"$class\::ISA"}, $plugin;
1584 =item $c->write( $data )
1586 Writes $data to the output stream. When using this method directly, you will
1587 need to manually set the Content-Length header to the length of your output
1595 # Finalize headers if someone manually writes output
1596 $c->finalize_headers;
1598 return $c->engine->write( $c, @_ );
1603 Returns the Catalyst version number. mostly useful for powered by messages
1604 in template systems.
1608 sub version { return $Catalyst::VERSION }
1612 =head1 INTERNAL ACTIONS
1614 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1615 C<_ACTION> and C<_END>, these are by default not shown in the private
1618 But you can deactivate this with a config parameter.
1620 MyApp->config->{show_internal_actions} = 1;
1622 =head1 CASE SENSITIVITY
1624 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1627 But you can activate case sensitivity with a config parameter.
1629 MyApp->config->{case_sensitive} = 1;
1631 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1633 =head1 ON-DEMAND PARSER
1635 The request body is usually parsed at the beginning of a request,
1636 but if you want to handle input yourself or speed things up a bit
1637 you can enable on-demand parsing with a config parameter.
1639 MyApp->config->{parse_on_demand} = 1;
1641 =head1 PROXY SUPPORT
1643 Many production servers operate using the common double-server approach, with
1644 a lightweight frontend web server passing requests to a larger backend
1645 server. An application running on the backend server must deal with two
1646 problems: the remote user always appears to be '127.0.0.1' and the server's
1647 hostname will appear to be 'localhost' regardless of the virtual host the
1648 user connected through.
1650 Catalyst will automatically detect this situation when you are running both
1651 the frontend and backend servers on the same machine. The following changes
1652 are made to the request.
1654 $c->req->address is set to the user's real IP address, as read from the
1655 HTTP_X_FORWARDED_FOR header.
1657 The host value for $c->req->base and $c->req->uri is set to the real host,
1658 as read from the HTTP_X_FORWARDED_HOST header.
1660 Obviously, your web server must support these 2 headers for this to work.
1662 In a more complex server farm environment where you may have your frontend
1663 proxy server(s) on different machines, you will need to set a configuration
1664 option to tell Catalyst to read the proxied data from the headers.
1666 MyApp->config->{using_frontend_proxy} = 1;
1668 If you do not wish to use the proxy support at all, you may set:
1670 MyApp->config->{ignore_frontend_proxy} = 1;
1672 =head1 THREAD SAFETY
1674 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1675 and the standalone forking HTTP server on Windows. We believe the Catalyst
1676 core to be thread-safe.
1678 If you plan to operate in a threaded environment, remember that all other
1679 modules you are using must also be thread-safe. Some modules, most notably
1680 DBD::SQLite, are not thread-safe.
1686 Join #catalyst on irc.perl.org.
1690 http://lists.rawmode.org/mailman/listinfo/catalyst
1691 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1695 http://catalyst.perl.org
1701 =item L<Catalyst::Manual> - The Catalyst Manual
1703 =item L<Catalyst::Engine> - Core Engine
1705 =item L<Catalyst::Log> - The Log Class.
1707 =item L<Catalyst::Request> - The Request Object
1709 =item L<Catalyst::Response> - The Response Object
1711 =item L<Catalyst::Test> - The test suite.
1775 Sebastian Riedel, C<sri@oook.de>
1779 This library is free software, you can redistribute it and/or modify it under
1780 the same terms as Perl itself.