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, @_ ) }
752 =item $c->execute($class, $coderef)
754 Execute a coderef in given class and catch exceptions.
755 Errors are available via $c->error.
760 my ( $c, $class, $code ) = @_;
761 $class = $c->components->{$class} || $class;
763 my $callsub = ( caller(1) )[3];
768 $action = "/$action" unless $action =~ /\-\>/;
769 $c->counter->{"$code"}++;
771 if ( $c->counter->{"$code"} > $RECURSION ) {
772 my $error = qq/Deep recursion detected in "$action"/;
773 $c->log->error($error);
779 $action = "-> $action" if $callsub =~ /forward$/;
785 my ( $elapsed, @state ) =
786 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
787 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
791 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
796 if ( my $error = $@ ) {
798 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
800 unless ( ref $error ) {
802 $error = qq/Caught exception "$error"/;
805 $c->log->error($error);
822 $c->finalize_uploads;
825 if ( $#{ $c->error } >= 0 ) {
829 $c->finalize_headers;
832 if ( $c->request->method eq 'HEAD' ) {
833 $c->response->body('');
838 return $c->response->status;
841 =item $c->finalize_body
847 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
849 =item $c->finalize_cookies
855 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
857 =item $c->finalize_error
863 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
865 =item $c->finalize_headers
871 sub finalize_headers {
874 # Check if we already finalized headers
875 return if $c->response->{_finalized_headers};
878 if ( my $location = $c->response->redirect ) {
879 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
880 $c->response->header( Location => $location );
884 if ( $c->response->body && !$c->response->content_length ) {
885 $c->response->content_length( bytes::length( $c->response->body ) );
889 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
890 $c->response->headers->remove_header("Content-Length");
891 $c->response->body('');
894 $c->finalize_cookies;
896 $c->engine->finalize_headers( $c, @_ );
899 $c->response->{_finalized_headers} = 1;
902 =item $c->finalize_output
904 An alias for finalize_body.
906 =item $c->finalize_read
908 Finalize the input after reading is complete.
912 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
914 =item $c->finalize_uploads
916 Finalize uploads. Cleans up any temporary files.
920 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
922 =item $c->get_action( $action, $namespace )
924 Get an action in a given namespace.
928 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
930 =item $c->get_actions( $action, $namespace )
932 Get all actions of a given name in a namespace and all base namespaces.
936 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
938 =item handle_request( $class, @arguments )
945 my ( $class, @arguments ) = @_;
947 # Always expect worst case!
953 my $c = $class->prepare(@arguments);
954 $c->{stats} = \@stats;
959 if ( $class->debug ) {
961 ( $elapsed, $status ) = $class->benchmark($handler);
962 $elapsed = sprintf '%f', $elapsed;
963 my $av = sprintf '%.3f',
964 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
965 my $t = Text::ASCIITable->new;
966 $t->setCols( 'Action', 'Time' );
967 $t->setColWidth( 'Action', 64, 1 );
968 $t->setColWidth( 'Time', 9, 1 );
970 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
972 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
974 else { $status = &$handler }
978 if ( my $error = $@ ) {
980 $class->log->error(qq/Caught exception in engine "$error"/);
984 $class->log->_flush() if $class->log->can('_flush');
988 =item $c->prepare(@arguments)
990 Turns the engine-specific request( Apache, CGI ... )
991 into a Catalyst context .
996 my ( $class, @arguments ) = @_;
1001 request => Catalyst::Request->new(
1004 body_parameters => {},
1006 headers => HTTP::Headers->new,
1008 query_parameters => {},
1014 response => Catalyst::Response->new(
1018 headers => HTTP::Headers->new(),
1026 # For on-demand data
1027 $c->request->{_context} = $c;
1028 $c->response->{_context} = $c;
1029 weaken( $c->request->{_context} );
1030 weaken( $c->response->{_context} );
1033 my $secs = time - $START || 1;
1034 my $av = sprintf '%.3f', $COUNT / $secs;
1035 $c->log->debug('**********************************');
1036 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1037 $c->log->debug('**********************************');
1038 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1041 $c->prepare_request(@arguments);
1042 $c->prepare_connection;
1043 $c->prepare_query_parameters;
1044 $c->prepare_headers;
1045 $c->prepare_cookies;
1049 $c->prepare_body unless $c->config->{parse_on_demand};
1052 my $method = $c->req->method || '';
1053 my $path = $c->req->path || '';
1054 my $address = $c->req->address || '';
1056 $c->log->debug(qq/"$method" request for "$path" from $address/)
1062 =item $c->prepare_action
1068 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1070 =item $c->prepare_body
1072 Prepare message body.
1079 # Do we run for the first time?
1080 return if defined $c->request->{_body};
1082 # Initialize on-demand data
1083 $c->engine->prepare_body( $c, @_ );
1084 $c->prepare_parameters;
1085 $c->prepare_uploads;
1087 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1088 my $t = Text::ASCIITable->new;
1089 $t->setCols( 'Key', 'Value' );
1090 $t->setColWidth( 'Key', 37, 1 );
1091 $t->setColWidth( 'Value', 36, 1 );
1092 $t->alignCol( 'Value', 'right' );
1093 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1094 my $param = $c->req->body_parameters->{$key};
1095 my $value = defined($param) ? $param : '';
1097 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1099 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1103 =item $c->prepare_body_chunk( $chunk )
1105 Prepare a chunk of data before sending it to HTTP::Body.
1109 sub prepare_body_chunk {
1111 $c->engine->prepare_body_chunk( $c, @_ );
1114 =item $c->prepare_body_parameters
1116 Prepare body parameters.
1120 sub prepare_body_parameters {
1122 $c->engine->prepare_body_parameters( $c, @_ );
1125 =item $c->prepare_connection
1131 sub prepare_connection {
1133 $c->engine->prepare_connection( $c, @_ );
1136 =item $c->prepare_cookies
1142 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1144 =item $c->prepare_headers
1150 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1152 =item $c->prepare_parameters
1158 sub prepare_parameters {
1160 $c->prepare_body_parameters;
1161 $c->engine->prepare_parameters( $c, @_ );
1164 =item $c->prepare_path
1166 Prepare path and base.
1170 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1172 =item $c->prepare_query_parameters
1174 Prepare query parameters.
1178 sub prepare_query_parameters {
1181 $c->engine->prepare_query_parameters( $c, @_ );
1183 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1184 my $t = Text::ASCIITable->new;
1185 $t->setCols( 'Key', 'Value' );
1186 $t->setColWidth( 'Key', 37, 1 );
1187 $t->setColWidth( 'Value', 36, 1 );
1188 $t->alignCol( 'Value', 'right' );
1189 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1190 my $param = $c->req->query_parameters->{$key};
1191 my $value = defined($param) ? $param : '';
1193 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1195 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1199 =item $c->prepare_read
1201 Prepare the input for reading.
1205 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1207 =item $c->prepare_request
1209 Prepare the engine request.
1213 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1215 =item $c->prepare_uploads
1221 sub prepare_uploads {
1224 $c->engine->prepare_uploads( $c, @_ );
1226 if ( $c->debug && keys %{ $c->request->uploads } ) {
1227 my $t = Text::ASCIITable->new;
1228 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1229 $t->setColWidth( 'Key', 12, 1 );
1230 $t->setColWidth( 'Filename', 28, 1 );
1231 $t->setColWidth( 'Type', 18, 1 );
1232 $t->setColWidth( 'Size', 9, 1 );
1233 $t->alignCol( 'Size', 'left' );
1234 for my $key ( sort keys %{ $c->request->uploads } ) {
1235 my $upload = $c->request->uploads->{$key};
1236 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1237 $t->addRow( $key, $u->filename, $u->type, $u->size );
1240 $c->log->debug( "File Uploads are:\n" . $t->draw );
1244 =item $c->prepare_write
1246 Prepare the output for writing.
1250 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1252 =item $c->read( [$maxlength] )
1254 Read a chunk of data from the request body. This method is designed to be
1255 used in a while loop, reading $maxlength bytes on every call. $maxlength
1256 defaults to the size of the request if not specified.
1258 You have to set MyApp->config->{parse_on_demand} to use this directly.
1262 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1270 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1272 =item $c->set_action( $action, $code, $namespace, $attrs )
1274 Set an action in a given namespace.
1278 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1280 =item $c->setup_actions($component)
1282 Setup actions for a component.
1286 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1288 =item $c->setup_components
1294 sub setup_components {
1297 my $callback = sub {
1298 my ( $component, $context ) = @_;
1300 unless ( $component->isa('Catalyst::Base') ) {
1304 my $suffix = Catalyst::Utils::class2classsuffix($component);
1305 my $config = $class->config->{$suffix} || {};
1309 eval { $instance = $component->new( $context, $config ); };
1311 if ( my $error = $@ ) {
1315 Catalyst::Exception->throw( message =>
1316 qq/Couldn't instantiate component "$component", "$error"/ );
1319 Catalyst::Exception->throw( message =>
1320 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1322 unless ref $instance;
1327 Module::Pluggable::Fast->import(
1328 name => '_catalyst_components',
1330 "$class\::Controller", "$class\::C",
1331 "$class\::Model", "$class\::M",
1332 "$class\::View", "$class\::V"
1334 callback => $callback
1338 if ( my $error = $@ ) {
1342 Catalyst::Exception->throw(
1343 message => qq/Couldn't load components "$error"/ );
1346 for my $component ( $class->_catalyst_components($class) ) {
1347 $class->components->{ ref $component || $component } = $component;
1351 =item $c->setup_dispatcher
1355 sub setup_dispatcher {
1356 my ( $class, $dispatcher ) = @_;
1359 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1362 if ( $ENV{CATALYST_DISPATCHER} ) {
1363 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1366 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1368 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1371 unless ($dispatcher) {
1372 $dispatcher = 'Catalyst::Dispatcher';
1375 $dispatcher->require;
1378 Catalyst::Exception->throw(
1379 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1382 # dispatcher instance
1383 $class->dispatcher( $dispatcher->new );
1386 =item $c->setup_engine
1391 my ( $class, $engine ) = @_;
1394 $engine = 'Catalyst::Engine::' . $engine;
1397 if ( $ENV{CATALYST_ENGINE} ) {
1398 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1401 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1402 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1405 if ( !$engine && $ENV{MOD_PERL} ) {
1407 # create the apache method
1410 *{"$class\::apache"} = sub { shift->engine->apache };
1413 my ( $software, $version ) =
1414 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1417 $version =~ s/(\.[^.]+)\./$1/g;
1419 if ( $software eq 'mod_perl' ) {
1421 if ( $version >= 1.99922 ) {
1422 $engine = 'Catalyst::Engine::Apache2::MP20';
1425 elsif ( $version >= 1.9901 ) {
1426 $engine = 'Catalyst::Engine::Apache2::MP19';
1429 elsif ( $version >= 1.24 ) {
1430 $engine = 'Catalyst::Engine::Apache::MP13';
1434 Catalyst::Exception->throw( message =>
1435 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1438 # install the correct mod_perl handler
1439 if ( $version >= 1.9901 ) {
1440 *handler = sub : method {
1441 shift->handle_request(@_);
1445 *handler = sub ($$) { shift->handle_request(@_) };
1450 elsif ( $software eq 'Zeus-Perl' ) {
1451 $engine = 'Catalyst::Engine::Zeus';
1455 Catalyst::Exception->throw(
1456 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1461 $engine = 'Catalyst::Engine::CGI';
1467 Catalyst::Exception->throw( message =>
1468 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1473 $class->engine( $engine->new );
1476 =item $c->setup_home
1481 my ( $class, $home ) = @_;
1483 if ( $ENV{CATALYST_HOME} ) {
1484 $home = $ENV{CATALYST_HOME};
1487 if ( $ENV{ uc($class) . '_HOME' } ) {
1488 $home = $ENV{ uc($class) . '_HOME' };
1492 $home = Catalyst::Utils::home($class);
1496 $class->config->{home} ||= $home;
1497 $class->config->{root} ||= dir($home)->subdir('root');
1506 my ( $class, $debug ) = @_;
1508 unless ( $class->log ) {
1509 $class->log( Catalyst::Log->new );
1512 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1514 *{"$class\::debug"} = sub { 1 };
1515 $class->log->debug('Debug messages enabled');
1519 =item $c->setup_plugins
1524 my ( $class, $plugins ) = @_;
1527 for my $plugin ( reverse @$plugins ) {
1529 $plugin = "Catalyst::Plugin::$plugin";
1534 Catalyst::Exception->throw(
1535 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1540 unshift @{"$class\::ISA"}, $plugin;
1545 =item $c->write( $data )
1547 Writes $data to the output stream. When using this method directly, you will
1548 need to manually set the Content-Length header to the length of your output
1556 # Finalize headers if someone manually writes output
1557 $c->finalize_headers;
1559 return $c->engine->write( $c, @_ );
1564 Returns the Catalyst version number. mostly useful for powered by messages
1565 in template systems.
1569 sub version { return $Catalyst::VERSION }
1573 =head1 INTERNAL ACTIONS
1575 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1576 C<_ACTION> and C<_END>, these are by default not shown in the private
1579 But you can deactivate this with a config parameter.
1581 MyApp->config->{show_internal_actions} = 1;
1583 =head1 CASE SENSITIVITY
1585 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1588 But you can activate case sensitivity with a config parameter.
1590 MyApp->config->{case_sensitive} = 1;
1592 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1594 =head1 ON-DEMAND PARSER
1596 The request body is usually parsed at the beginning of a request,
1597 but if you want to handle input yourself or speed things up a bit
1598 you can enable on-demand parsing with a config parameter.
1600 MyApp->config->{parse_on_demand} = 1;
1602 =head1 PROXY SUPPORT
1604 Many production servers operate using the common double-server approach, with
1605 a lightweight frontend web server passing requests to a larger backend
1606 server. An application running on the backend server must deal with two
1607 problems: the remote user always appears to be '127.0.0.1' and the server's
1608 hostname will appear to be 'localhost' regardless of the virtual host the
1609 user connected through.
1611 Catalyst will automatically detect this situation when you are running both
1612 the frontend and backend servers on the same machine. The following changes
1613 are made to the request.
1615 $c->req->address is set to the user's real IP address, as read from the
1616 HTTP_X_FORWARDED_FOR header.
1618 The host value for $c->req->base and $c->req->uri is set to the real host,
1619 as read from the HTTP_X_FORWARDED_HOST header.
1621 Obviously, your web server must support these 2 headers for this to work.
1623 In a more complex server farm environment where you may have your frontend
1624 proxy server(s) on different machines, you will need to set a configuration
1625 option to tell Catalyst to read the proxied data from the headers.
1627 MyApp->config->{using_frontend_proxy} = 1;
1629 If you do not wish to use the proxy support at all, you may set:
1631 MyApp->config->{ignore_frontend_proxy} = 1;
1633 =head1 THREAD SAFETY
1635 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1636 and the standalone forking HTTP server on Windows. We believe the Catalyst
1637 core to be thread-safe.
1639 If you plan to operate in a threaded environment, remember that all other
1640 modules you are using must also be thread-safe. Some modules, most notably
1641 DBD::SQLite, are not thread-safe.
1647 Join #catalyst on irc.perl.org.
1651 http://lists.rawmode.org/mailman/listinfo/catalyst
1652 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1656 http://catalyst.perl.org
1662 =item L<Catalyst::Manual> - The Catalyst Manual
1664 =item L<Catalyst::Engine> - Core Engine
1666 =item L<Catalyst::Log> - The Log Class.
1668 =item L<Catalyst::Request> - The Request Object
1670 =item L<Catalyst::Response> - The Response Object
1672 =item L<Catalyst::Test> - The test suite.
1736 Sebastian Riedel, C<sri@oook.de>
1740 This library is free software, you can redistribute it and/or modify it under
1741 the same terms as Perl itself.