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 = 10;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_02';
49 my ( $class, @arguments ) = @_;
51 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
53 return unless $class eq 'Catalyst';
55 my $caller = caller(0);
57 unless ( $caller->isa('Catalyst') ) {
59 push @{"$caller\::ISA"}, $class;
62 $caller->arguments( [@arguments] );
68 Catalyst - The Elegant MVC Web Application Framework
72 # use the helper to start a new application
76 # add models, views, controllers
77 script/myapp_create.pl model Something
78 script/myapp_create.pl view Stuff
79 script/myapp_create.pl controller Yada
82 script/myapp_server.pl
84 # command line interface
85 script/myapp_test.pl /yada
90 use Catalyst qw/My::Module My::OtherModule/;
92 use Catalyst '-Debug';
94 use Catalyst qw/-Debug -Engine=CGI/;
96 sub default : Private { $_[1]->res->output('Hello') } );
98 sub index : Path('/index.html') {
99 my ( $self, $c ) = @_;
100 $c->res->output('Hello');
104 sub product : Regex('^product[_]*(\d*).html$') {
105 my ( $self, $c ) = @_;
106 $c->stash->{template} = 'product.tt';
107 $c->stash->{product} = $c->req->snippets->[0];
110 See also L<Catalyst::Manual::Intro>
114 The key concept of Catalyst is DRY (Don't Repeat Yourself).
116 See L<Catalyst::Manual> for more documentation.
118 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
119 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
120 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
122 use Catalyst 'My::Module';
124 Special flags like -Debug and -Engine can also be specified as arguments when
127 use Catalyst qw/-Debug My::Module/;
129 The position of plugins and flags in the chain is important, because they are
130 loaded in exactly the order that they appear.
132 The following flags are supported:
138 enables debug output, i.e.:
140 use Catalyst '-Debug';
142 this is equivalent to:
149 Force Catalyst to use a specific dispatcher.
153 Force Catalyst to use a specific engine.
154 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
156 use Catalyst '-Engine=CGI';
160 Force Catalyst to use a specific home directory.
174 Accessor for the current action
176 =item $c->comp($name)
178 =item $c->component($name)
180 Get a component object by name.
182 $c->comp('MyApp::Model::MyModel')->do_stuff;
193 my $appclass = ref $c || $c;
196 $name, "${appclass}::${name}",
197 map { "${appclass}::${_}::${name}" } qw/M V C/
200 foreach my $try (@names) {
202 if ( exists $c->components->{$try} ) {
204 return $c->components->{$try};
208 foreach my $component ( keys %{ $c->components } ) {
210 return $c->components->{$component} if $component =~ /$name/i;
215 return sort keys %{ $c->components };
220 Returns a hashref containing your applications settings.
224 Overload to enable debug messages.
230 =item $c->detach( $command [, \@arguments ] )
232 Like C<forward> but doesn't return.
236 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
240 Contains the dispatcher instance.
241 Stringifies to class.
243 =item $c->forward( $command [, \@arguments ] )
245 Forward processing to a private action or a method from a class.
246 If you define a class without method it will default to process().
247 also takes an optional arrayref containing arguments to be passed
248 to the new function. $c->req->args will be reset upon returning
252 $c->forward('index');
253 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
254 $c->forward('MyApp::View::TT');
258 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
262 Accessor to the namespace of the current action
264 =item $c->path_to(@path)
266 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
270 $c->path_to( 'db', 'sqlite.db' );
275 my ( $c, @path ) = @_;
276 my $path = dir( $c->config->{home}, @path );
277 if ( -d $path ) { return $path }
278 else { return file( $c->config->{home}, @path ) }
290 my ( $class, @arguments ) = @_;
292 unless ( $class->isa('Catalyst') ) {
294 Catalyst::Exception->throw(
295 message => qq/'$class' does not inherit from Catalyst/ );
298 if ( $class->arguments ) {
299 @arguments = ( @arguments, @{ $class->arguments } );
305 foreach (@arguments) {
309 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
311 elsif (/^-(\w+)=?(.*)$/) {
312 $flags->{ lc $1 } = $2;
315 push @{ $flags->{plugins} }, $_;
319 $class->setup_log( delete $flags->{log} );
320 $class->setup_plugins( delete $flags->{plugins} );
321 $class->setup_dispatcher( delete $flags->{dispatcher} );
322 $class->setup_engine( delete $flags->{engine} );
323 $class->setup_home( delete $flags->{home} );
325 for my $flag ( sort keys %{$flags} ) {
327 if ( my $code = $class->can( 'setup_' . $flag ) ) {
328 &$code( $class, delete $flags->{$flag} );
331 $class->log->warn(qq/Unknown flag "$flag"/);
335 $class->log->warn( "You are running an old helper script! "
336 . "Please update your scripts by regenerating the "
337 . "application and copying over the new scripts." )
338 if ( $ENV{CATALYST_SCRIPT_GEN}
339 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
341 if ( $class->debug ) {
347 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
351 my $t = Text::ASCIITable->new;
352 $t->setOptions( 'hide_HeadRow', 1 );
353 $t->setOptions( 'hide_HeadLine', 1 );
354 $t->setCols('Class');
355 $t->setColWidth( 'Class', 75, 1 );
356 $t->addRow($_) for @plugins;
357 $class->log->debug( "Loaded plugins:\n" . $t->draw );
360 my $dispatcher = $class->dispatcher;
361 my $engine = $class->engine;
362 my $home = $class->config->{home};
364 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
365 $class->log->debug(qq/Loaded engine "$engine"/);
369 ? $class->log->debug(qq/Found home "$home"/)
370 : $class->log->debug(qq/Home "$home" doesn't exist/)
371 : $class->log->debug(q/Couldn't find home/);
376 no warnings qw/redefine/;
377 local *setup = sub { };
381 # Initialize our data structure
382 $class->components( {} );
384 $class->setup_components;
386 if ( $class->debug ) {
387 my $t = Text::ASCIITable->new;
388 $t->setOptions( 'hide_HeadRow', 1 );
389 $t->setOptions( 'hide_HeadLine', 1 );
390 $t->setCols('Class');
391 $t->setColWidth( 'Class', 75, 1 );
392 $t->addRow($_) for sort keys %{ $class->components };
393 $class->log->debug( "Loaded components:\n" . $t->draw )
394 if ( @{ $t->{tbl_rows} } );
397 # Add our self to components, since we are also a component
398 $class->components->{$class} = $class;
400 $class->setup_actions;
402 if ( $class->debug ) {
403 my $name = $class->config->{name} || 'Application';
404 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
406 $class->log->_flush() if $class->log->can('_flush');
409 =item $c->uri_for($path,[@args])
411 Merges path with $c->request->base for absolute uri's and with
412 $c->request->match for relative uri's, then returns a normalized
413 L<URI> object. If any args are passed, they are added at the end
419 my ( $c, $path, @args ) = @_;
420 my $base = $c->request->base->clone;
421 my $basepath = $base->path;
422 $basepath =~ s/\/$//;
424 my $match = $c->request->match;
426 # massage match, empty if absolute path
428 $match .= '/' if $match;
430 $match = '' if $path =~ /^\//;
433 # join args with '/', or a blank string
434 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
435 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
441 =item $c->error($error, ...)
443 =item $c->error($arrayref)
445 Returns an arrayref containing error messages.
447 my @error = @{ $c->error };
451 $c->error('Something bad happened');
462 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
463 push @{ $c->{error} }, @$error;
465 elsif ( defined $_[0] ) { $c->{error} = undef }
466 return $c->{error} || [];
471 Contains the engine instance.
472 Stringifies to the class.
476 Contains the logging object. Unless it is already set Catalyst sets this up with a
477 C<Catalyst::Log> object. To use your own log class:
479 $c->log( MyLogger->new );
480 $c->log->info("now logging with my own logger!");
482 Your log class should implement the methods described in the C<Catalyst::Log>
485 =item $c->plugin( $name, $class, @args )
487 Instant plugins for Catalyst.
488 Classdata accessor/mutator will be created, class loaded and instantiated.
490 MyApp->plugin( 'prototype', 'HTML::Prototype' );
492 $c->prototype->define_javascript_functions;
497 my ( $class, $name, $plugin, @args ) = @_;
500 if ( my $error = $UNIVERSAL::require::ERROR ) {
501 Catalyst::Exception->throw(
502 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
505 eval { $plugin->import };
506 $class->mk_classdata($name);
508 eval { $obj = $plugin->new(@args) };
511 Catalyst::Exception->throw( message =>
512 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
516 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
524 Returns a C<Catalyst::Request> object.
532 Returns a C<Catalyst::Response> object.
538 Contains the return value of the last executed action.
542 Returns a hashref containing all your data.
544 print $c->stash->{foo};
546 Keys may be set in the stash by assigning to the hash reference, or by passing
547 either a single hash reference or a list of key/value pairs as arguments.
551 $c->stash->{foo} ||= 'yada';
552 $c->stash( { moose => 'majestic', qux => 0 } );
553 $c->stash( bar => 1, gorch => 2 );
560 my $stash = @_ > 1 ? {@_} : $_[0];
561 while ( my ( $key, $val ) = each %$stash ) {
562 $c->{stash}->{$key} = $val;
568 =item $c->welcome_message
570 Returns the Catalyst welcome HTML page.
574 sub welcome_message {
576 my $name = $c->config->{name};
577 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
578 my $prefix = Catalyst::Utils::appprefix( ref $c );
579 $c->response->content_type('text/html; charset=utf-8');
581 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
582 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
583 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
585 <meta http-equiv="Content-Language" content="en" />
586 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
587 <title>$name on Catalyst $VERSION</title>
588 <style type="text/css">
591 background-color: #eee;
600 background-color: #ccc;
601 border: 1px solid #aaa;
602 -moz-border-radius: 10px;
607 font-family: verdana, tahoma, sans-serif;
610 font-family: verdana, tahoma, sans-serif;
613 text-decoration: none;
615 border-bottom: 1px dotted #bbb;
617 :link:hover, :visited:hover {
630 background-color: #fff;
631 border: 1px solid #aaa;
632 -moz-border-radius: 10px;
658 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
663 <img src="$logo" alt="Catalyst Logo" />
665 <p>Welcome to the wonderful world of Catalyst.
666 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
667 framework will make web development something you had
668 never expected it to be: Fun, rewarding and quick.</p>
669 <h2>What to do now?</h2>
670 <p>That really depends on what <b>you</b> want to do.
671 We do, however, provide you with a few starting points.</p>
672 <p>If you want to jump right into web development with Catalyst
673 you might want to check out the documentation.</p>
674 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
675 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
676 <h2>What to do next?</h2>
677 <p>Next it's time to write an actual application. Use the
678 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
679 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
680 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
681 they can save you a lot of work.</p>
682 <pre><code>script/${prefix}_create.pl -help</code></pre>
683 <p>Also, be sure to check out the vast and growing
684 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
685 you are likely to find what you need there.
689 <p>Catalyst has a very active community. Here are the main places to
690 get in touch with us.</p>
693 <a href="http://dev.catalyst.perl.org">Wiki</a>
696 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
699 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
702 <h2>In conclusion</h2>
703 <p>The Catalyst team hopes you will enjoy using Catalyst as much
704 as we enjoyed making it. Please contact us if you have ideas
705 for improvement or other feedback.</p>
715 =head1 INTERNAL METHODS
719 =item $c->benchmark($coderef)
721 Takes a coderef with arguments and returns elapsed time as float.
723 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
724 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
731 my $time = [gettimeofday];
732 my @return = &$code(@_);
733 my $elapsed = tv_interval $time;
734 return wantarray ? ( $elapsed, @return ) : $elapsed;
739 Contains the components.
743 Returns a hashref containing coderefs and execution counts.
744 (Needed for deep recursion detection)
748 Returns the actual forward depth.
752 Dispatch request to actions.
756 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
760 Returns a list of 2-element array references (name, structure) pairs that will
761 be dumped on the error page in debug mode.
767 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
770 =item $c->execute($class, $coderef)
772 Execute a coderef in given class and catch exceptions.
773 Errors are available via $c->error.
778 my ( $c, $class, $code ) = @_;
779 $class = $c->components->{$class} || $class;
781 my $callsub = ( caller(1) )[3];
786 $action = "/$action" unless $action =~ /\-\>/;
787 $c->counter->{"$code"}++;
789 if ( $c->counter->{"$code"} > $RECURSION ) {
790 my $error = qq/Deep recursion detected in "$action"/;
791 $c->log->error($error);
797 $action = "-> $action" if $callsub =~ /forward$/;
803 my ( $elapsed, @state ) =
804 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
805 unless ( ( $code->name =~ /^_.*/ )
806 && ( !$c->config->{show_internal_actions} ) )
808 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
813 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
818 if ( my $error = $@ ) {
820 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
822 unless ( ref $error ) {
824 $error = qq/Caught exception "$error"/;
827 $c->log->error($error);
844 $c->finalize_uploads;
847 if ( $#{ $c->error } >= 0 ) {
851 $c->finalize_headers;
854 if ( $c->request->method eq 'HEAD' ) {
855 $c->response->body('');
860 return $c->response->status;
863 =item $c->finalize_body
869 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
871 =item $c->finalize_cookies
877 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
879 =item $c->finalize_error
885 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
887 =item $c->finalize_headers
893 sub finalize_headers {
896 # Check if we already finalized headers
897 return if $c->response->{_finalized_headers};
900 if ( my $location = $c->response->redirect ) {
901 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
902 $c->response->header( Location => $location );
906 if ( $c->response->body && !$c->response->content_length ) {
907 $c->response->content_length( bytes::length( $c->response->body ) );
911 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
912 $c->response->headers->remove_header("Content-Length");
913 $c->response->body('');
916 $c->finalize_cookies;
918 $c->engine->finalize_headers( $c, @_ );
921 $c->response->{_finalized_headers} = 1;
924 =item $c->finalize_output
926 An alias for finalize_body.
928 =item $c->finalize_read
930 Finalize the input after reading is complete.
934 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
936 =item $c->finalize_uploads
938 Finalize uploads. Cleans up any temporary files.
942 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
944 =item $c->get_action( $action, $namespace )
946 Get an action in a given namespace.
950 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
952 =item $c->get_actions( $action, $namespace )
954 Get all actions of a given name in a namespace and all base namespaces.
958 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
960 =item handle_request( $class, @arguments )
967 my ( $class, @arguments ) = @_;
969 # Always expect worst case!
975 my $c = $class->prepare(@arguments);
976 $c->{stats} = \@stats;
981 if ( $class->debug ) {
983 ( $elapsed, $status ) = $class->benchmark($handler);
984 $elapsed = sprintf '%f', $elapsed;
985 my $av = sprintf '%.3f',
986 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
987 my $t = Text::ASCIITable->new;
988 $t->setCols( 'Action', 'Time' );
989 $t->setColWidth( 'Action', 64, 1 );
990 $t->setColWidth( 'Time', 9, 1 );
992 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
994 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
996 else { $status = &$handler }
1000 if ( my $error = $@ ) {
1002 $class->log->error(qq/Caught exception in engine "$error"/);
1006 $class->log->_flush() if $class->log->can('_flush');
1010 =item $c->prepare(@arguments)
1012 Turns the engine-specific request( Apache, CGI ... )
1013 into a Catalyst context .
1018 my ( $class, @arguments ) = @_;
1023 request => Catalyst::Request->new(
1026 body_parameters => {},
1028 headers => HTTP::Headers->new,
1030 query_parameters => {},
1036 response => Catalyst::Response->new(
1040 headers => HTTP::Headers->new(),
1048 # For on-demand data
1049 $c->request->{_context} = $c;
1050 $c->response->{_context} = $c;
1051 weaken( $c->request->{_context} );
1052 weaken( $c->response->{_context} );
1055 my $secs = time - $START || 1;
1056 my $av = sprintf '%.3f', $COUNT / $secs;
1057 $c->log->debug('**********************************');
1058 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1059 $c->log->debug('**********************************');
1060 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1063 $c->prepare_request(@arguments);
1064 $c->prepare_connection;
1065 $c->prepare_query_parameters;
1066 $c->prepare_headers;
1067 $c->prepare_cookies;
1071 $c->prepare_body unless $c->config->{parse_on_demand};
1074 my $method = $c->req->method || '';
1075 my $path = $c->req->path || '';
1076 my $address = $c->req->address || '';
1078 $c->log->debug(qq/"$method" request for "$path" from $address/)
1084 =item $c->prepare_action
1090 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1092 =item $c->prepare_body
1094 Prepare message body.
1101 # Do we run for the first time?
1102 return if defined $c->request->{_body};
1104 # Initialize on-demand data
1105 $c->engine->prepare_body( $c, @_ );
1106 $c->prepare_parameters;
1107 $c->prepare_uploads;
1109 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1110 my $t = Text::ASCIITable->new;
1111 $t->setCols( 'Key', 'Value' );
1112 $t->setColWidth( 'Key', 37, 1 );
1113 $t->setColWidth( 'Value', 36, 1 );
1114 $t->alignCol( 'Value', 'right' );
1115 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1116 my $param = $c->req->body_parameters->{$key};
1117 my $value = defined($param) ? $param : '';
1119 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1121 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1125 =item $c->prepare_body_chunk( $chunk )
1127 Prepare a chunk of data before sending it to HTTP::Body.
1131 sub prepare_body_chunk {
1133 $c->engine->prepare_body_chunk( $c, @_ );
1136 =item $c->prepare_body_parameters
1138 Prepare body parameters.
1142 sub prepare_body_parameters {
1144 $c->engine->prepare_body_parameters( $c, @_ );
1147 =item $c->prepare_connection
1153 sub prepare_connection {
1155 $c->engine->prepare_connection( $c, @_ );
1158 =item $c->prepare_cookies
1164 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1166 =item $c->prepare_headers
1172 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1174 =item $c->prepare_parameters
1180 sub prepare_parameters {
1182 $c->prepare_body_parameters;
1183 $c->engine->prepare_parameters( $c, @_ );
1186 =item $c->prepare_path
1188 Prepare path and base.
1192 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1194 =item $c->prepare_query_parameters
1196 Prepare query parameters.
1200 sub prepare_query_parameters {
1203 $c->engine->prepare_query_parameters( $c, @_ );
1205 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1206 my $t = Text::ASCIITable->new;
1207 $t->setCols( 'Key', 'Value' );
1208 $t->setColWidth( 'Key', 37, 1 );
1209 $t->setColWidth( 'Value', 36, 1 );
1210 $t->alignCol( 'Value', 'right' );
1211 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1212 my $param = $c->req->query_parameters->{$key};
1213 my $value = defined($param) ? $param : '';
1215 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1217 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1221 =item $c->prepare_read
1223 Prepare the input for reading.
1227 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1229 =item $c->prepare_request
1231 Prepare the engine request.
1235 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1237 =item $c->prepare_uploads
1243 sub prepare_uploads {
1246 $c->engine->prepare_uploads( $c, @_ );
1248 if ( $c->debug && keys %{ $c->request->uploads } ) {
1249 my $t = Text::ASCIITable->new;
1250 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1251 $t->setColWidth( 'Key', 12, 1 );
1252 $t->setColWidth( 'Filename', 28, 1 );
1253 $t->setColWidth( 'Type', 18, 1 );
1254 $t->setColWidth( 'Size', 9, 1 );
1255 $t->alignCol( 'Size', 'left' );
1256 for my $key ( sort keys %{ $c->request->uploads } ) {
1257 my $upload = $c->request->uploads->{$key};
1258 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1259 $t->addRow( $key, $u->filename, $u->type, $u->size );
1262 $c->log->debug( "File Uploads are:\n" . $t->draw );
1266 =item $c->prepare_write
1268 Prepare the output for writing.
1272 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1274 =item $c->read( [$maxlength] )
1276 Read a chunk of data from the request body. This method is designed to be
1277 used in a while loop, reading $maxlength bytes on every call. $maxlength
1278 defaults to the size of the request if not specified.
1280 You have to set MyApp->config->{parse_on_demand} to use this directly.
1284 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1292 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1294 =item $c->set_action( $action, $code, $namespace, $attrs )
1296 Set an action in a given namespace.
1300 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1302 =item $c->setup_actions($component)
1304 Setup actions for a component.
1308 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1310 =item $c->setup_components
1316 sub setup_components {
1319 my $callback = sub {
1320 my ( $component, $context ) = @_;
1322 unless ( $component->isa('Catalyst::Base') ) {
1326 my $suffix = Catalyst::Utils::class2classsuffix($component);
1327 my $config = $class->config->{$suffix} || {};
1331 eval { $instance = $component->new( $context, $config ); };
1333 if ( my $error = $@ ) {
1337 Catalyst::Exception->throw( message =>
1338 qq/Couldn't instantiate component "$component", "$error"/ );
1341 Catalyst::Exception->throw( message =>
1342 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1344 unless ref $instance;
1349 Module::Pluggable::Fast->import(
1350 name => '_catalyst_components',
1352 "$class\::Controller", "$class\::C",
1353 "$class\::Model", "$class\::M",
1354 "$class\::View", "$class\::V"
1356 callback => $callback
1360 if ( my $error = $@ ) {
1364 Catalyst::Exception->throw(
1365 message => qq/Couldn't load components "$error"/ );
1368 for my $component ( $class->_catalyst_components($class) ) {
1369 $class->components->{ ref $component || $component } = $component;
1373 =item $c->setup_dispatcher
1377 sub setup_dispatcher {
1378 my ( $class, $dispatcher ) = @_;
1381 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1384 if ( $ENV{CATALYST_DISPATCHER} ) {
1385 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1388 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1390 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1393 unless ($dispatcher) {
1394 $dispatcher = 'Catalyst::Dispatcher';
1397 $dispatcher->require;
1400 Catalyst::Exception->throw(
1401 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1404 # dispatcher instance
1405 $class->dispatcher( $dispatcher->new );
1408 =item $c->setup_engine
1413 my ( $class, $engine ) = @_;
1416 $engine = 'Catalyst::Engine::' . $engine;
1419 if ( $ENV{CATALYST_ENGINE} ) {
1420 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1423 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1424 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1427 if ( !$engine && $ENV{MOD_PERL} ) {
1429 # create the apache method
1432 *{"$class\::apache"} = sub { shift->engine->apache };
1435 my ( $software, $version ) =
1436 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1439 $version =~ s/(\.[^.]+)\./$1/g;
1441 if ( $software eq 'mod_perl' ) {
1443 if ( $version >= 1.99922 ) {
1444 $engine = 'Catalyst::Engine::Apache2::MP20';
1447 elsif ( $version >= 1.9901 ) {
1448 $engine = 'Catalyst::Engine::Apache2::MP19';
1451 elsif ( $version >= 1.24 ) {
1452 $engine = 'Catalyst::Engine::Apache::MP13';
1456 Catalyst::Exception->throw( message =>
1457 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1460 # install the correct mod_perl handler
1461 if ( $version >= 1.9901 ) {
1462 *handler = sub : method {
1463 shift->handle_request(@_);
1467 *handler = sub ($$) { shift->handle_request(@_) };
1472 elsif ( $software eq 'Zeus-Perl' ) {
1473 $engine = 'Catalyst::Engine::Zeus';
1477 Catalyst::Exception->throw(
1478 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1483 $engine = 'Catalyst::Engine::CGI';
1489 Catalyst::Exception->throw( message =>
1490 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1494 # check for old engines that are no longer compatible
1496 if ( $engine->isa('Catalyst::Engine::Apache')
1497 && !Catalyst::Engine::Apache->VERSION )
1502 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1503 && Catalyst::Engine::Server->VERSION le '0.02' )
1508 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1509 && $engine->VERSION eq '0.01' )
1514 elsif ($engine->isa('Catalyst::Engine::Zeus')
1515 && $engine->VERSION eq '0.01' )
1521 Catalyst::Exception->throw( message =>
1522 qq/Engine "$engine" is not supported by this version of Catalyst/
1527 $class->engine( $engine->new );
1530 =item $c->setup_home
1535 my ( $class, $home ) = @_;
1537 if ( $ENV{CATALYST_HOME} ) {
1538 $home = $ENV{CATALYST_HOME};
1541 if ( $ENV{ uc($class) . '_HOME' } ) {
1542 $home = $ENV{ uc($class) . '_HOME' };
1546 $home = Catalyst::Utils::home($class);
1550 $class->config->{home} ||= $home;
1551 $class->config->{root} ||= dir($home)->subdir('root');
1560 my ( $class, $debug ) = @_;
1562 unless ( $class->log ) {
1563 $class->log( Catalyst::Log->new );
1566 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1568 *{"$class\::debug"} = sub { 1 };
1569 $class->log->debug('Debug messages enabled');
1573 =item $c->setup_plugins
1578 my ( $class, $plugins ) = @_;
1581 for my $plugin ( reverse @$plugins ) {
1583 $plugin = "Catalyst::Plugin::$plugin";
1588 Catalyst::Exception->throw(
1589 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1594 unshift @{"$class\::ISA"}, $plugin;
1599 =item $c->write( $data )
1601 Writes $data to the output stream. When using this method directly, you will
1602 need to manually set the Content-Length header to the length of your output
1610 # Finalize headers if someone manually writes output
1611 $c->finalize_headers;
1613 return $c->engine->write( $c, @_ );
1618 Returns the Catalyst version number. mostly useful for powered by messages
1619 in template systems.
1623 sub version { return $Catalyst::VERSION }
1627 =head1 INTERNAL ACTIONS
1629 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1630 C<_ACTION> and C<_END>, these are by default not shown in the private
1633 But you can deactivate this with a config parameter.
1635 MyApp->config->{show_internal_actions} = 1;
1637 =head1 CASE SENSITIVITY
1639 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1642 But you can activate case sensitivity with a config parameter.
1644 MyApp->config->{case_sensitive} = 1;
1646 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1648 =head1 ON-DEMAND PARSER
1650 The request body is usually parsed at the beginning of a request,
1651 but if you want to handle input yourself or speed things up a bit
1652 you can enable on-demand parsing with a config parameter.
1654 MyApp->config->{parse_on_demand} = 1;
1656 =head1 PROXY SUPPORT
1658 Many production servers operate using the common double-server approach, with
1659 a lightweight frontend web server passing requests to a larger backend
1660 server. An application running on the backend server must deal with two
1661 problems: the remote user always appears to be '127.0.0.1' and the server's
1662 hostname will appear to be 'localhost' regardless of the virtual host the
1663 user connected through.
1665 Catalyst will automatically detect this situation when you are running both
1666 the frontend and backend servers on the same machine. The following changes
1667 are made to the request.
1669 $c->req->address is set to the user's real IP address, as read from the
1670 HTTP_X_FORWARDED_FOR header.
1672 The host value for $c->req->base and $c->req->uri is set to the real host,
1673 as read from the HTTP_X_FORWARDED_HOST header.
1675 Obviously, your web server must support these 2 headers for this to work.
1677 In a more complex server farm environment where you may have your frontend
1678 proxy server(s) on different machines, you will need to set a configuration
1679 option to tell Catalyst to read the proxied data from the headers.
1681 MyApp->config->{using_frontend_proxy} = 1;
1683 If you do not wish to use the proxy support at all, you may set:
1685 MyApp->config->{ignore_frontend_proxy} = 1;
1687 =head1 THREAD SAFETY
1689 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1690 and the standalone forking HTTP server on Windows. We believe the Catalyst
1691 core to be thread-safe.
1693 If you plan to operate in a threaded environment, remember that all other
1694 modules you are using must also be thread-safe. Some modules, most notably
1695 DBD::SQLite, are not thread-safe.
1701 Join #catalyst on irc.perl.org.
1705 http://lists.rawmode.org/mailman/listinfo/catalyst
1706 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1710 http://catalyst.perl.org
1716 =item L<Catalyst::Manual> - The Catalyst Manual
1718 =item L<Catalyst::Engine> - Core Engine
1720 =item L<Catalyst::Log> - The Log Class.
1722 =item L<Catalyst::Request> - The Request Object
1724 =item L<Catalyst::Response> - The Response Object
1726 =item L<Catalyst::Test> - The test suite.
1790 Sebastian Riedel, C<sri@oook.de>
1794 This library is free software, you can redistribute it and/or modify it under
1795 the same terms as Perl itself.