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 = 8;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_01';
48 sub version { return $Catalyst::VERSION }
51 my ( $class, @arguments ) = @_;
53 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
55 return unless $class eq 'Catalyst';
57 my $caller = caller(0);
59 unless ( $caller->isa('Catalyst') ) {
61 push @{"$caller\::ISA"}, $class;
64 $caller->arguments( [@arguments] );
70 Catalyst - The Elegant MVC Web Application Framework
74 # use the helper to start a new application
78 # add models, views, controllers
79 script/myapp_create.pl model Something
80 script/myapp_create.pl view Stuff
81 script/myapp_create.pl controller Yada
84 script/myapp_server.pl
86 # command line interface
87 script/myapp_test.pl /yada
92 use Catalyst qw/My::Module My::OtherModule/;
94 use Catalyst '-Debug';
96 use Catalyst qw/-Debug -Engine=CGI/;
98 sub default : Private { $_[1]->res->output('Hello') } );
100 sub index : Path('/index.html') {
101 my ( $self, $c ) = @_;
102 $c->res->output('Hello');
106 sub product : Regex('^product[_]*(\d*).html$') {
107 my ( $self, $c ) = @_;
108 $c->stash->{template} = 'product.tt';
109 $c->stash->{product} = $c->req->snippets->[0];
112 See also L<Catalyst::Manual::Intro>
116 The key concept of Catalyst is DRY (Don't Repeat Yourself).
118 See L<Catalyst::Manual> for more documentation.
120 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
121 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
122 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
124 use Catalyst 'My::Module';
126 Special flags like -Debug and -Engine can also be specified as arguments when
129 use Catalyst qw/-Debug My::Module/;
131 The position of plugins and flags in the chain is important, because they are
132 loaded in exactly the order that they appear.
134 The following flags are supported:
140 enables debug output, i.e.:
142 use Catalyst '-Debug';
144 this is equivalent to:
151 Force Catalyst to use a specific dispatcher.
155 Force Catalyst to use a specific engine.
156 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
158 use Catalyst '-Engine=CGI';
162 Force Catalyst to use a specific home directory.
176 Accessor for the current action
178 =item $c->comp($name)
180 =item $c->component($name)
182 Get a component object by name.
184 $c->comp('MyApp::Model::MyModel')->do_stuff;
195 my $appclass = ref $c || $c;
198 $name, "${appclass}::${name}",
199 map { "${appclass}::${_}::${name}" } qw/M V C/
202 foreach my $try (@names) {
204 if ( exists $c->components->{$try} ) {
206 return $c->components->{$try};
210 foreach my $component ( keys %{ $c->components } ) {
212 return $c->components->{$component} if $component =~ /$name/i;
217 return sort keys %{ $c->components };
222 Returns a hashref containing your applications settings.
226 Overload to enable debug messages.
232 =item $c->detach( $command [, \@arguments ] )
234 Like C<forward> but doesn't return.
238 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
242 Contains the dispatcher instance.
243 Stringifies to class.
245 =item $c->forward( $command [, \@arguments ] )
247 Forward processing to a private action or a method from a class.
248 If you define a class without method it will default to process().
249 also takes an optional arrayref containing arguments to be passed
250 to the new function. $c->req->args will be reset upon returning
254 $c->forward('index');
255 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
256 $c->forward('MyApp::View::TT');
260 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
264 Accessor to the namespace of the current action
266 =item $c->path_to(@path)
268 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
272 $c->path_to( 'db', 'sqlite.db' );
277 my ( $c, @path ) = @_;
278 my $path = dir( $c->config->{home}, @path );
279 if ( -d $path ) { return $path }
280 else { return file( $c->config->{home}, @path ) }
292 my ( $class, @arguments ) = @_;
294 unless ( $class->isa('Catalyst') ) {
296 Catalyst::Exception->throw(
297 message => qq/'$class' does not inherit from Catalyst/ );
300 if ( $class->arguments ) {
301 @arguments = ( @arguments, @{ $class->arguments } );
307 foreach (@arguments) {
311 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
313 elsif (/^-(\w+)=?(.*)$/) {
314 $flags->{ lc $1 } = $2;
317 push @{ $flags->{plugins} }, $_;
321 $class->setup_log( delete $flags->{log} );
322 $class->setup_plugins( delete $flags->{plugins} );
323 $class->setup_dispatcher( delete $flags->{dispatcher} );
324 $class->setup_engine( delete $flags->{engine} );
325 $class->setup_home( delete $flags->{home} );
327 for my $flag ( sort keys %{$flags} ) {
329 if ( my $code = $class->can( 'setup_' . $flag ) ) {
330 &$code( $class, delete $flags->{$flag} );
333 $class->log->warn(qq/Unknown flag "$flag"/);
337 $class->log->warn( "You are running an old helper script! "
338 . "Please update your scripts by regenerating the "
339 . "application and copying over the new scripts." )
340 if ( $ENV{CATALYST_SCRIPT_GEN}
341 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
343 if ( $class->debug ) {
349 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
353 my $t = Text::ASCIITable->new;
354 $t->setOptions( 'hide_HeadRow', 1 );
355 $t->setOptions( 'hide_HeadLine', 1 );
356 $t->setCols('Class');
357 $t->setColWidth( 'Class', 75, 1 );
358 $t->addRow($_) for @plugins;
359 $class->log->debug( "Loaded plugins:\n" . $t->draw );
362 my $dispatcher = $class->dispatcher;
363 my $engine = $class->engine;
364 my $home = $class->config->{home};
366 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
367 $class->log->debug(qq/Loaded engine "$engine"/);
371 ? $class->log->debug(qq/Found home "$home"/)
372 : $class->log->debug(qq/Home "$home" doesn't exist/)
373 : $class->log->debug(q/Couldn't find home/);
378 no warnings qw/redefine/;
379 local *setup = sub { };
383 # Initialize our data structure
384 $class->components( {} );
386 $class->setup_components;
388 if ( $class->debug ) {
389 my $t = Text::ASCIITable->new;
390 $t->setOptions( 'hide_HeadRow', 1 );
391 $t->setOptions( 'hide_HeadLine', 1 );
392 $t->setCols('Class');
393 $t->setColWidth( 'Class', 75, 1 );
394 $t->addRow($_) for sort keys %{ $class->components };
395 $class->log->debug( "Loaded components:\n" . $t->draw )
396 if ( @{ $t->{tbl_rows} } );
399 # Add our self to components, since we are also a component
400 $class->components->{$class} = $class;
402 $class->setup_actions;
404 if ( $class->debug ) {
405 my $name = $class->config->{name} || 'Application';
406 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
408 $class->log->_flush() if $class->log->can('_flush');
411 =item $c->uri_for($path,[@args])
413 Merges path with $c->request->base for absolute uri's and with
414 $c->request->match for relative uri's, then returns a normalized
415 L<URI> object. If any args are passed, they are added at the end
421 my ( $c, $path, @args ) = @_;
422 my $base = $c->request->base->clone;
423 my $basepath = $base->path;
424 $basepath =~ s/\/$//;
426 my $match = $c->request->match;
428 # massage match, empty if absolute path
430 $match .= '/' if $match;
431 $match = '' if $path =~ /^\//;
434 # join args with '/', or a blank string
435 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
436 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
442 =item $c->error($error, ...)
444 =item $c->error($arrayref)
446 Returns an arrayref containing error messages.
448 my @error = @{ $c->error };
452 $c->error('Something bad happened');
463 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
464 push @{ $c->{error} }, @$error;
466 elsif ( defined $_[0] ) { $c->{error} = undef }
467 return $c->{error} || [];
472 Contains the engine instance.
473 Stringifies to the class.
477 Contains the logging object. Unless it is already set Catalyst sets this up with a
478 C<Catalyst::Log> object. To use your own log class:
480 $c->log( MyLogger->new );
481 $c->log->info("now logging with my own logger!");
483 Your log class should implement the methods described in the C<Catalyst::Log>
486 =item $c->plugin( $name, $class, @args )
488 Instant plugins for Catalyst.
489 Classdata accessor/mutator will be created, class loaded and instantiated.
491 MyApp->plugin( 'prototype', 'HTML::Prototype' );
493 $c->prototype->define_javascript_functions;
498 my ( $class, $name, $plugin, @args ) = @_;
501 if ( my $error = $UNIVERSAL::require::ERROR ) {
502 Catalyst::Exception->throw(
503 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
506 eval { $plugin->import };
507 $class->mk_classdata($name);
509 eval { $obj = $plugin->new(@args) };
512 Catalyst::Exception->throw( message =>
513 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
517 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
525 Returns a C<Catalyst::Request> object.
533 Returns a C<Catalyst::Response> object.
539 Contains the return value of the last executed action.
543 Returns a hashref containing all your data.
545 print $c->stash->{foo};
547 Keys may be set in the stash by assigning to the hash reference, or by passing
548 either a single hash reference or a list of key/value pairs as arguments.
552 $c->stash->{foo} ||= 'yada';
553 $c->stash( { moose => 'majestic', qux => 0 } );
554 $c->stash( bar => 1, gorch => 2 );
561 my $stash = @_ > 1 ? {@_} : $_[0];
562 while ( my ( $key, $val ) = each %$stash ) {
563 $c->{stash}->{$key} = $val;
569 =item $c->welcome_message
571 Returns the Catalyst welcome HTML page.
575 sub welcome_message {
577 my $name = $c->config->{name};
578 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
579 my $prefix = Catalyst::Utils::appprefix( ref $c );
583 <title>$name on Catalyst $VERSION</title>
584 <style type="text/css">
589 background-color: #eee;
597 background-color: #ccc;
598 border: 1px solid #aaa;
599 -moz-border-radius: 10px;
604 font-family: verdana, tahoma, sans-serif;
607 font-family: verdana, tahoma, sans-serif;
610 text-decoration: none;
612 border-bottom: 1px dotted #bbb;
614 :link:hover, :visited:hover {
627 background-color: #fff;
628 border: 1px solid #aaa;
629 -moz-border-radius: 10px;
654 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
661 <p>Welcome to the wonderful world of Catalyst.
662 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
663 framework will make web development something you had
664 never expected it to be: Fun, rewarding and quick.</p>
665 <h2>What to do now?</h2>
666 <p>That really depends on what <b>you</b> want to do.
667 We do, however, provide you with a few starting points.</p>
668 <p>If you want to jump right into web development with Catalyst
669 you might want to check out the documentation.</p>
670 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
671 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
672 <h2>What to do next?</h2>
673 <p>Next it's time to write an actual application. Use the
674 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
675 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
676 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
677 they can save you a lot of work.</p>
678 <pre><code>script/${prefix}_create.pl -help</code></pre>
679 <p>Also, be sure to check out the vast and growing
680 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
681 you are likely to find what you need there.
685 <p>Catalyst has a very active community. Here are the main places to
686 get in touch with us.</p>
689 <a href="http://dev.catalyst.perl.org">Wiki</a>
692 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
695 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
698 <h2>In conclusion</h2>
699 <p>The Catalyst team hope you will enjoy using Catalyst as much
700 as we enjoyed making it. Please contact us if you have ideas
701 for improvement or other feedback.</p>
711 =head1 INTERNAL METHODS
715 =item $c->benchmark($coderef)
717 Takes a coderef with arguments and returns elapsed time as float.
719 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
720 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
727 my $time = [gettimeofday];
728 my @return = &$code(@_);
729 my $elapsed = tv_interval $time;
730 return wantarray ? ( $elapsed, @return ) : $elapsed;
735 Contains the components.
739 Returns a hashref containing coderefs and execution counts.
740 (Needed for deep recursion detection)
744 Returns the actual forward depth.
748 Dispatch request to actions.
752 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
754 =item $c->execute($class, $coderef)
756 Execute a coderef in given class and catch exceptions.
757 Errors are available via $c->error.
762 my ( $c, $class, $code ) = @_;
763 $class = $c->components->{$class} || $class;
765 my $callsub = ( caller(1) )[3];
770 $action = "/$action" unless $action =~ /\-\>/;
771 $c->counter->{"$code"}++;
773 if ( $c->counter->{"$code"} > $RECURSION ) {
774 my $error = qq/Deep recursion detected in "$action"/;
775 $c->log->error($error);
781 $action = "-> $action" if $callsub =~ /forward$/;
787 my ( $elapsed, @state ) =
788 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
789 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
793 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
798 if ( my $error = $@ ) {
800 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
802 unless ( ref $error ) {
804 $error = qq/Caught exception "$error"/;
807 $c->log->error($error);
824 $c->finalize_uploads;
827 if ( $#{ $c->error } >= 0 ) {
831 $c->finalize_headers;
834 if ( $c->request->method eq 'HEAD' ) {
835 $c->response->body('');
840 return $c->response->status;
843 =item $c->finalize_body
849 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
851 =item $c->finalize_cookies
857 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
859 =item $c->finalize_error
865 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
867 =item $c->finalize_headers
873 sub finalize_headers {
876 # Check if we already finalized headers
877 return if $c->response->{_finalized_headers};
880 if ( my $location = $c->response->redirect ) {
881 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
882 $c->response->header( Location => $location );
886 if ( $c->response->body && !$c->response->content_length ) {
887 $c->response->content_length( bytes::length( $c->response->body ) );
891 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
892 $c->response->headers->remove_header("Content-Length");
893 $c->response->body('');
896 $c->finalize_cookies;
898 $c->engine->finalize_headers( $c, @_ );
901 $c->response->{_finalized_headers} = 1;
904 =item $c->finalize_output
906 An alias for finalize_body.
908 =item $c->finalize_read
910 Finalize the input after reading is complete.
914 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
916 =item $c->finalize_uploads
918 Finalize uploads. Cleans up any temporary files.
922 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
924 =item $c->get_action( $action, $namespace, $inherit )
926 Get an action in a given namespace.
930 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
932 =item handle_request( $class, @arguments )
939 my ( $class, @arguments ) = @_;
941 # Always expect worst case!
947 my $c = $class->prepare(@arguments);
948 $c->{stats} = \@stats;
953 if ( $class->debug ) {
955 ( $elapsed, $status ) = $class->benchmark($handler);
956 $elapsed = sprintf '%f', $elapsed;
957 my $av = sprintf '%.3f',
958 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
959 my $t = Text::ASCIITable->new;
960 $t->setCols( 'Action', 'Time' );
961 $t->setColWidth( 'Action', 64, 1 );
962 $t->setColWidth( 'Time', 9, 1 );
964 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
966 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
968 else { $status = &$handler }
972 if ( my $error = $@ ) {
974 $class->log->error(qq/Caught exception in engine "$error"/);
978 $class->log->_flush() if $class->log->can('_flush');
982 =item $c->prepare(@arguments)
984 Turns the engine-specific request( Apache, CGI ... )
985 into a Catalyst context .
990 my ( $class, @arguments ) = @_;
995 request => Catalyst::Request->new(
998 body_parameters => {},
1000 headers => HTTP::Headers->new,
1002 query_parameters => {},
1008 response => Catalyst::Response->new(
1012 headers => HTTP::Headers->new(),
1020 # For on-demand data
1021 $c->request->{_context} = $c;
1022 $c->response->{_context} = $c;
1023 weaken( $c->request->{_context} );
1024 weaken( $c->response->{_context} );
1027 my $secs = time - $START || 1;
1028 my $av = sprintf '%.3f', $COUNT / $secs;
1029 $c->log->debug('**********************************');
1030 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1031 $c->log->debug('**********************************');
1032 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1035 $c->prepare_request(@arguments);
1036 $c->prepare_connection;
1037 $c->prepare_query_parameters;
1038 $c->prepare_headers;
1039 $c->prepare_cookies;
1043 $c->prepare_body unless $c->config->{parse_on_demand};
1046 my $method = $c->req->method || '';
1047 my $path = $c->req->path || '';
1048 my $address = $c->req->address || '';
1050 $c->log->debug(qq/"$method" request for "$path" from $address/)
1056 =item $c->prepare_action
1062 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1064 =item $c->prepare_body
1066 Prepare message body.
1073 # Do we run for the first time?
1074 return if defined $c->request->{_body};
1076 # Initialize on-demand data
1077 $c->engine->prepare_body( $c, @_ );
1078 $c->prepare_parameters;
1079 $c->prepare_uploads;
1081 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1082 my $t = Text::ASCIITable->new;
1083 $t->setCols( 'Key', 'Value' );
1084 $t->setColWidth( 'Key', 37, 1 );
1085 $t->setColWidth( 'Value', 36, 1 );
1086 $t->alignCol( 'Value', 'right' );
1087 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1088 my $param = $c->req->body_parameters->{$key};
1089 my $value = defined($param) ? $param : '';
1091 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1093 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1097 =item $c->prepare_body_chunk( $chunk )
1099 Prepare a chunk of data before sending it to HTTP::Body.
1103 sub prepare_body_chunk {
1105 $c->engine->prepare_body_chunk( $c, @_ );
1108 =item $c->prepare_body_parameters
1110 Prepare body parameters.
1114 sub prepare_body_parameters {
1116 $c->engine->prepare_body_parameters( $c, @_ );
1119 =item $c->prepare_connection
1125 sub prepare_connection {
1127 $c->engine->prepare_connection( $c, @_ );
1130 =item $c->prepare_cookies
1136 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1138 =item $c->prepare_headers
1144 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1146 =item $c->prepare_parameters
1152 sub prepare_parameters {
1154 $c->prepare_body_parameters;
1155 $c->engine->prepare_parameters( $c, @_ );
1158 =item $c->prepare_path
1160 Prepare path and base.
1164 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1166 =item $c->prepare_query_parameters
1168 Prepare query parameters.
1172 sub prepare_query_parameters {
1175 $c->engine->prepare_query_parameters( $c, @_ );
1177 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1178 my $t = Text::ASCIITable->new;
1179 $t->setCols( 'Key', 'Value' );
1180 $t->setColWidth( 'Key', 37, 1 );
1181 $t->setColWidth( 'Value', 36, 1 );
1182 $t->alignCol( 'Value', 'right' );
1183 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1184 my $param = $c->req->query_parameters->{$key};
1185 my $value = defined($param) ? $param : '';
1187 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1189 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1193 =item $c->prepare_read
1195 Prepare the input for reading.
1199 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1201 =item $c->prepare_request
1203 Prepare the engine request.
1207 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1209 =item $c->prepare_uploads
1215 sub prepare_uploads {
1218 $c->engine->prepare_uploads( $c, @_ );
1220 if ( $c->debug && keys %{ $c->request->uploads } ) {
1221 my $t = Text::ASCIITable->new;
1222 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1223 $t->setColWidth( 'Key', 12, 1 );
1224 $t->setColWidth( 'Filename', 28, 1 );
1225 $t->setColWidth( 'Type', 18, 1 );
1226 $t->setColWidth( 'Size', 9, 1 );
1227 $t->alignCol( 'Size', 'left' );
1228 for my $key ( sort keys %{ $c->request->uploads } ) {
1229 my $upload = $c->request->uploads->{$key};
1230 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1231 $t->addRow( $key, $u->filename, $u->type, $u->size );
1234 $c->log->debug( "File Uploads are:\n" . $t->draw );
1238 =item $c->prepare_write
1240 Prepare the output for writing.
1244 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1246 =item $c->read( [$maxlength] )
1248 Read a chunk of data from the request body. This method is designed to be
1249 used in a while loop, reading $maxlength bytes on every call. $maxlength
1250 defaults to the size of the request if not specified.
1252 You have to set MyApp->config->{parse_on_demand} to use this directly.
1256 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1264 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1266 =item $c->set_action( $action, $code, $namespace, $attrs )
1268 Set an action in a given namespace.
1272 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1274 =item $c->setup_actions($component)
1276 Setup actions for a component.
1280 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1282 =item $c->setup_components
1288 sub setup_components {
1291 my $callback = sub {
1292 my ( $component, $context ) = @_;
1294 unless ( $component->isa('Catalyst::Base') ) {
1298 my $suffix = Catalyst::Utils::class2classsuffix($component);
1299 my $config = $class->config->{$suffix} || {};
1303 eval { $instance = $component->new( $context, $config ); };
1305 if ( my $error = $@ ) {
1309 Catalyst::Exception->throw( message =>
1310 qq/Couldn't instantiate component "$component", "$error"/ );
1313 Catalyst::Exception->throw( message =>
1314 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1316 unless ref $instance;
1321 Module::Pluggable::Fast->import(
1322 name => '_catalyst_components',
1324 "$class\::Controller", "$class\::C",
1325 "$class\::Model", "$class\::M",
1326 "$class\::View", "$class\::V"
1328 callback => $callback
1332 if ( my $error = $@ ) {
1336 Catalyst::Exception->throw(
1337 message => qq/Couldn't load components "$error"/ );
1340 for my $component ( $class->_catalyst_components($class) ) {
1341 $class->components->{ ref $component || $component } = $component;
1345 =item $c->setup_dispatcher
1349 sub setup_dispatcher {
1350 my ( $class, $dispatcher ) = @_;
1353 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1356 if ( $ENV{CATALYST_DISPATCHER} ) {
1357 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1360 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1362 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1365 unless ($dispatcher) {
1366 $dispatcher = 'Catalyst::Dispatcher';
1369 $dispatcher->require;
1372 Catalyst::Exception->throw(
1373 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1376 # dispatcher instance
1377 $class->dispatcher( $dispatcher->new );
1380 =item $c->setup_engine
1385 my ( $class, $engine ) = @_;
1388 $engine = 'Catalyst::Engine::' . $engine;
1391 if ( $ENV{CATALYST_ENGINE} ) {
1392 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1395 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1396 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1399 if ( !$engine && $ENV{MOD_PERL} ) {
1401 # create the apache method
1404 *{"$class\::apache"} = sub { shift->engine->apache };
1407 my ( $software, $version ) =
1408 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1411 $version =~ s/(\.[^.]+)\./$1/g;
1413 if ( $software eq 'mod_perl' ) {
1415 if ( $version >= 1.99922 ) {
1416 $engine = 'Catalyst::Engine::Apache2::MP20';
1419 elsif ( $version >= 1.9901 ) {
1420 $engine = 'Catalyst::Engine::Apache2::MP19';
1423 elsif ( $version >= 1.24 ) {
1424 $engine = 'Catalyst::Engine::Apache::MP13';
1428 Catalyst::Exception->throw( message =>
1429 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1432 # install the correct mod_perl handler
1433 if ( $version >= 1.9901 ) {
1434 *handler = sub : method {
1435 shift->handle_request(@_);
1439 *handler = sub ($$) { shift->handle_request(@_) };
1444 elsif ( $software eq 'Zeus-Perl' ) {
1445 $engine = 'Catalyst::Engine::Zeus';
1449 Catalyst::Exception->throw(
1450 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1455 $engine = 'Catalyst::Engine::CGI';
1461 Catalyst::Exception->throw( message =>
1462 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1467 $class->engine( $engine->new );
1470 =item $c->setup_home
1475 my ( $class, $home ) = @_;
1477 if ( $ENV{CATALYST_HOME} ) {
1478 $home = $ENV{CATALYST_HOME};
1481 if ( $ENV{ uc($class) . '_HOME' } ) {
1482 $home = $ENV{ uc($class) . '_HOME' };
1486 $home = Catalyst::Utils::home($class);
1490 $class->config->{home} ||= $home;
1491 $class->config->{root} ||= dir($home)->subdir('root');
1500 my ( $class, $debug ) = @_;
1502 unless ( $class->log ) {
1503 $class->log( Catalyst::Log->new );
1506 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1508 *{"$class\::debug"} = sub { 1 };
1509 $class->log->debug('Debug messages enabled');
1513 =item $c->setup_plugins
1518 my ( $class, $plugins ) = @_;
1521 for my $plugin ( reverse @$plugins ) {
1523 $plugin = "Catalyst::Plugin::$plugin";
1528 Catalyst::Exception->throw(
1529 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1534 unshift @{"$class\::ISA"}, $plugin;
1539 =item $c->write( $data )
1541 Writes $data to the output stream. When using this method directly, you will
1542 need to manually set the Content-Length header to the length of your output
1550 # Finalize headers if someone manually writes output
1551 $c->finalize_headers;
1553 return $c->engine->write( $c, @_ );
1558 =head1 CASE SENSITIVITY
1560 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1563 But you can activate case sensitivity with a config parameter.
1565 MyApp->config->{case_sensitive} = 1;
1567 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1569 =head1 ON-DEMAND PARSER
1571 The request body is usually parsed at the beginning of a request,
1572 but if you want to handle input yourself or speed things up a bit
1573 you can enable on-demand parsing with a config parameter.
1575 MyApp->config->{parse_on_demand} = 1;
1577 =head1 PROXY SUPPORT
1579 Many production servers operate using the common double-server approach, with
1580 a lightweight frontend web server passing requests to a larger backend
1581 server. An application running on the backend server must deal with two
1582 problems: the remote user always appears to be '127.0.0.1' and the server's
1583 hostname will appear to be 'localhost' regardless of the virtual host the
1584 user connected through.
1586 Catalyst will automatically detect this situation when you are running both
1587 the frontend and backend servers on the same machine. The following changes
1588 are made to the request.
1590 $c->req->address is set to the user's real IP address, as read from the
1591 HTTP_X_FORWARDED_FOR header.
1593 The host value for $c->req->base and $c->req->uri is set to the real host,
1594 as read from the HTTP_X_FORWARDED_HOST header.
1596 Obviously, your web server must support these 2 headers for this to work.
1598 In a more complex server farm environment where you may have your frontend
1599 proxy server(s) on different machines, you will need to set a configuration
1600 option to tell Catalyst to read the proxied data from the headers.
1602 MyApp->config->{using_frontend_proxy} = 1;
1604 If you do not wish to use the proxy support at all, you may set:
1606 MyApp->config->{ignore_frontend_proxy} = 1;
1608 =head1 THREAD SAFETY
1610 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1611 and the standalone forking HTTP server on Windows. We believe the Catalyst
1612 core to be thread-safe.
1614 If you plan to operate in a threaded environment, remember that all other
1615 modules you are using must also be thread-safe. Some modules, most notably
1616 DBD::SQLite, are not thread-safe.
1622 Join #catalyst on irc.perl.org.
1626 http://lists.rawmode.org/mailman/listinfo/catalyst
1627 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1631 http://catalyst.perl.org
1637 =item L<Catalyst::Manual> - The Catalyst Manual
1639 =item L<Catalyst::Engine> - Core Engine
1641 =item L<Catalyst::Log> - The Log Class.
1643 =item L<Catalyst::Request> - The Request Object
1645 =item L<Catalyst::Response> - The Response Object
1647 =item L<Catalyst::Test> - The test suite.
1709 Sebastian Riedel, C<sri@oook.de>
1713 This library is free software, you can redistribute it and/or modify it under
1714 the same terms as Perl itself.