4 use base 'Catalyst::Base';
6 use UNIVERSAL::require;
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
14 use Text::SimpleTable;
16 use Time::HiRes qw/gettimeofday tv_interval/;
18 use Scalar::Util qw/weaken/;
20 __PACKAGE__->mk_accessors(
21 qw/counter depth request response state action namespace/
29 # For backwards compatibility
30 *finalize_output = \&finalize_body;
35 our $RECURSION = 1000;
36 our $DETACH = "catalyst_detach\n";
38 require Module::Pluggable::Fast;
40 # Helper script generation
41 our $CATALYST_SCRIPT_GEN = 10;
43 __PACKAGE__->mk_classdata($_)
44 for qw/components arguments dispatcher engine log/;
46 our $VERSION = '5.49_03';
49 my ( $class, @arguments ) = @_;
51 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
53 return unless $class eq 'Catalyst';
55 my $caller = caller(0);
57 unless ( $caller->isa('Catalyst') ) {
59 push @{"$caller\::ISA"}, $class;
62 $caller->arguments( [@arguments] );
68 Catalyst - The Elegant MVC Web Application Framework
72 # use the helper to start a new application
76 # add models, views, controllers
77 script/myapp_create.pl model Something
78 script/myapp_create.pl view Stuff
79 script/myapp_create.pl controller Yada
82 script/myapp_server.pl
84 # command line interface
85 script/myapp_test.pl /yada
90 use Catalyst qw/My::Module My::OtherModule/;
92 use Catalyst '-Debug';
94 use Catalyst qw/-Debug -Engine=CGI/;
96 sub default : Private { $_[1]->res->output('Hello') } );
98 sub index : Path('/index.html') {
99 my ( $self, $c ) = @_;
100 $c->res->output('Hello');
104 sub product : Regex('^product[_]*(\d*).html$') {
105 my ( $self, $c ) = @_;
106 $c->stash->{template} = 'product.tt';
107 $c->stash->{product} = $c->req->snippets->[0];
110 See also L<Catalyst::Manual::Intro>
114 The key concept of Catalyst is DRY (Don't Repeat Yourself).
116 See L<Catalyst::Manual> for more documentation.
118 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
119 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
120 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
122 use Catalyst 'My::Module';
124 Special flags like -Debug and -Engine can also be specified as arguments when
127 use Catalyst qw/-Debug My::Module/;
129 The position of plugins and flags in the chain is important, because they are
130 loaded in exactly the order that they appear.
132 The following flags are supported:
138 enables debug output, i.e.:
140 use Catalyst '-Debug';
142 this is equivalent to:
149 Force Catalyst to use a specific dispatcher.
153 Force Catalyst to use a specific engine.
154 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
156 use Catalyst '-Engine=CGI';
160 Force Catalyst to use a specific home directory.
174 Accessor for the current action
176 =item $c->comp($name)
178 =item $c->component($name)
180 Get a component object by name.
182 $c->comp('MyApp::Model::MyModel')->do_stuff;
193 my $appclass = ref $c || $c;
196 $name, "${appclass}::${name}",
197 map { "${appclass}::${_}::${name}" } qw/M V C/
200 foreach my $try (@names) {
202 if ( exists $c->components->{$try} ) {
204 return $c->components->{$try};
208 foreach my $component ( keys %{ $c->components } ) {
210 return $c->components->{$component} if $component =~ /$name/i;
215 return sort keys %{ $c->components };
220 Returns a hashref containing your applications settings.
224 =item $c->controller($name)
226 Get a L<Catalyst::Controller> instance by name.
228 $c->controller('Foo')->do_stuff;
233 my ( $c, $name ) = @_;
234 my $controller = $c->comp("Controller::$name");
235 return $controller if $controller;
236 return $c->comp("C::$name");
241 Overload to enable debug messages.
247 =item $c->detach( $command [, \@arguments ] )
249 Like C<forward> but doesn't return.
253 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
257 Contains the dispatcher instance.
258 Stringifies to class.
260 =item $c->forward( $command [, \@arguments ] )
262 Forward processing to a private action or a method from a class.
263 If you define a class without method it will default to process().
264 also takes an optional arrayref containing arguments to be passed
265 to the new function. $c->req->args will be reset upon returning
269 $c->forward('index');
270 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
271 $c->forward('MyApp::View::TT');
275 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
277 =item $c->model($name)
279 Get a L<Catalyst::Model> instance by name.
281 $c->model('Foo')->do_stuff;
286 my ( $c, $name ) = @_;
287 my $model = $c->comp("Model::$name");
288 return $model if $model;
289 return $c->comp("M::$name");
294 Accessor to the namespace of the current action
296 =item $c->path_to(@path)
298 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
302 $c->path_to( 'db', 'sqlite.db' );
307 my ( $c, @path ) = @_;
308 my $path = dir( $c->config->{home}, @path );
309 if ( -d $path ) { return $path }
310 else { return file( $c->config->{home}, @path ) }
322 my ( $class, @arguments ) = @_;
324 unless ( $class->isa('Catalyst') ) {
326 Catalyst::Exception->throw(
327 message => qq/'$class' does not inherit from Catalyst/ );
330 if ( $class->arguments ) {
331 @arguments = ( @arguments, @{ $class->arguments } );
337 foreach (@arguments) {
341 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
343 elsif (/^-(\w+)=?(.*)$/) {
344 $flags->{ lc $1 } = $2;
347 push @{ $flags->{plugins} }, $_;
351 $class->setup_log( delete $flags->{log} );
352 $class->setup_plugins( delete $flags->{plugins} );
353 $class->setup_dispatcher( delete $flags->{dispatcher} );
354 $class->setup_engine( delete $flags->{engine} );
355 $class->setup_home( delete $flags->{home} );
357 for my $flag ( sort keys %{$flags} ) {
359 if ( my $code = $class->can( 'setup_' . $flag ) ) {
360 &$code( $class, delete $flags->{$flag} );
363 $class->log->warn(qq/Unknown flag "$flag"/);
367 $class->log->warn( "You are running an old helper script! "
368 . "Please update your scripts by regenerating the "
369 . "application and copying over the new scripts." )
370 if ( $ENV{CATALYST_SCRIPT_GEN}
371 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
373 if ( $class->debug ) {
379 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
383 my $t = Text::SimpleTable->new(76);
384 $t->row($_) for @plugins;
385 $class->log->debug( "Loaded plugins:\n" . $t->draw );
388 my $dispatcher = $class->dispatcher;
389 my $engine = $class->engine;
390 my $home = $class->config->{home};
392 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
393 $class->log->debug(qq/Loaded engine "$engine"/);
397 ? $class->log->debug(qq/Found home "$home"/)
398 : $class->log->debug(qq/Home "$home" doesn't exist/)
399 : $class->log->debug(q/Couldn't find home/);
404 no warnings qw/redefine/;
405 local *setup = sub { };
409 # Initialize our data structure
410 $class->components( {} );
412 $class->setup_components;
414 if ( $class->debug ) {
415 my $t = Text::SimpleTable->new(76);
416 $t->row($_) for sort keys %{ $class->components };
417 $class->log->debug( "Loaded components:\n" . $t->draw )
418 if ( keys %{ $class->components } );
421 # Add our self to components, since we are also a component
422 $class->components->{$class} = $class;
424 $class->setup_actions;
426 if ( $class->debug ) {
427 my $name = $class->config->{name} || 'Application';
428 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
430 $class->log->_flush() if $class->log->can('_flush');
433 =item $c->uri_for($path,[@args])
435 Merges path with $c->request->base for absolute uri's and with
436 $c->request->match for relative uri's, then returns a normalized
437 L<URI> object. If any args are passed, they are added at the end
443 my ( $c, $path, @args ) = @_;
444 my $base = $c->request->base->clone;
445 my $basepath = $base->path;
446 $basepath =~ s/\/$//;
448 my $match = $c->request->match;
450 # massage match, empty if absolute path
452 $match .= '/' if $match;
454 $match = '' if $path =~ /^\//;
457 # join args with '/', or a blank string
458 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
459 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
465 =item $c->error($error, ...)
467 =item $c->error($arrayref)
469 Returns an arrayref containing error messages.
471 my @error = @{ $c->error };
475 $c->error('Something bad happened');
486 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
487 push @{ $c->{error} }, @$error;
489 elsif ( defined $_[0] ) { $c->{error} = undef }
490 return $c->{error} || [];
495 Contains the engine instance.
496 Stringifies to the class.
500 Contains the logging object. Unless it is already set Catalyst sets this up with a
501 C<Catalyst::Log> object. To use your own log class:
503 $c->log( MyLogger->new );
504 $c->log->info("now logging with my own logger!");
506 Your log class should implement the methods described in the C<Catalyst::Log>
509 =item $c->plugin( $name, $class, @args )
511 Instant plugins for Catalyst.
512 Classdata accessor/mutator will be created, class loaded and instantiated.
514 MyApp->plugin( 'prototype', 'HTML::Prototype' );
516 $c->prototype->define_javascript_functions;
521 my ( $class, $name, $plugin, @args ) = @_;
524 if ( my $error = $UNIVERSAL::require::ERROR ) {
525 Catalyst::Exception->throw(
526 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
529 eval { $plugin->import };
530 $class->mk_classdata($name);
532 eval { $obj = $plugin->new(@args) };
535 Catalyst::Exception->throw( message =>
536 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
540 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
548 Returns a C<Catalyst::Request> object.
556 Returns a C<Catalyst::Response> object.
562 Contains the return value of the last executed action.
566 Returns a hashref containing all your data.
568 print $c->stash->{foo};
570 Keys may be set in the stash by assigning to the hash reference, or by passing
571 either a single hash reference or a list of key/value pairs as arguments.
575 $c->stash->{foo} ||= 'yada';
576 $c->stash( { moose => 'majestic', qux => 0 } );
577 $c->stash( bar => 1, gorch => 2 );
584 my $stash = @_ > 1 ? {@_} : $_[0];
585 while ( my ( $key, $val ) = each %$stash ) {
586 $c->{stash}->{$key} = $val;
592 =item $c->view($name)
594 Get a L<Catalyst::View> instance by name.
596 $c->view('Foo')->do_stuff;
601 my ( $c, $name ) = @_;
602 my $view = $c->comp("View::$name");
603 return $view if $view;
604 return $c->comp("V::$name");
607 =item $c->welcome_message
609 Returns the Catalyst welcome HTML page.
613 sub welcome_message {
615 my $name = $c->config->{name};
616 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
617 my $prefix = Catalyst::Utils::appprefix( ref $c );
618 $c->response->content_type('text/html; charset=utf-8');
620 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
621 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
622 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
624 <meta http-equiv="Content-Language" content="en" />
625 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
626 <title>$name on Catalyst $VERSION</title>
627 <style type="text/css">
630 background-color: #eee;
639 background-color: #ccc;
640 border: 1px solid #aaa;
641 -moz-border-radius: 10px;
646 font-family: verdana, tahoma, sans-serif;
649 font-family: verdana, tahoma, sans-serif;
652 text-decoration: none;
654 border-bottom: 1px dotted #bbb;
656 :link:hover, :visited:hover {
669 background-color: #fff;
670 border: 1px solid #aaa;
671 -moz-border-radius: 10px;
697 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
702 <img src="$logo" alt="Catalyst Logo" />
704 <p>Welcome to the wonderful world of Catalyst.
705 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
706 framework will make web development something you had
707 never expected it to be: Fun, rewarding and quick.</p>
708 <h2>What to do now?</h2>
709 <p>That really depends on what <b>you</b> want to do.
710 We do, however, provide you with a few starting points.</p>
711 <p>If you want to jump right into web development with Catalyst
712 you might want to check out the documentation.</p>
713 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
714 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
715 <h2>What to do next?</h2>
716 <p>Next it's time to write an actual application. Use the
717 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
718 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
719 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
720 they can save you a lot of work.</p>
721 <pre><code>script/${prefix}_create.pl -help</code></pre>
722 <p>Also, be sure to check out the vast and growing
723 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
724 you are likely to find what you need there.
728 <p>Catalyst has a very active community. Here are the main places to
729 get in touch with us.</p>
732 <a href="http://dev.catalyst.perl.org">Wiki</a>
735 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
738 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
741 <h2>In conclusion</h2>
742 <p>The Catalyst team hopes you will enjoy using Catalyst as much
743 as we enjoyed making it. Please contact us if you have ideas
744 for improvement or other feedback.</p>
754 =head1 INTERNAL METHODS
758 =item $c->benchmark($coderef)
760 Takes a coderef with arguments and returns elapsed time as float.
762 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
763 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
770 my $time = [gettimeofday];
771 my @return = &$code(@_);
772 my $elapsed = tv_interval $time;
773 return wantarray ? ( $elapsed, @return ) : $elapsed;
778 Contains the components.
782 Returns a hashref containing coderefs and execution counts.
783 (Needed for deep recursion detection)
787 Returns the actual forward depth.
791 Dispatch request to actions.
795 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
799 Returns a list of 2-element array references (name, structure) pairs that will
800 be dumped on the error page in debug mode.
806 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
809 =item $c->execute($class, $coderef)
811 Execute a coderef in given class and catch exceptions.
812 Errors are available via $c->error.
817 my ( $c, $class, $code ) = @_;
818 $class = $c->components->{$class} || $class;
820 my $callsub = ( caller(1) )[3];
825 $action = "/$action" unless $action =~ /\-\>/;
826 $c->counter->{"$code"}++;
828 if ( $c->counter->{"$code"} > $RECURSION ) {
829 my $error = qq/Deep recursion detected in "$action"/;
830 $c->log->error($error);
836 $action = "-> $action" if $callsub =~ /forward$/;
842 my ( $elapsed, @state ) =
843 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
844 unless ( ( $code->name =~ /^_.*/ )
845 && ( !$c->config->{show_internal_actions} ) )
847 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
852 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
857 if ( my $error = $@ ) {
859 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
861 unless ( ref $error ) {
863 $error = qq/Caught exception "$error"/;
881 for my $error ( @{ $c->error } ) {
882 $c->log->error($error);
885 $c->finalize_uploads;
888 if ( $#{ $c->error } >= 0 ) {
892 $c->finalize_headers;
895 if ( $c->request->method eq 'HEAD' ) {
896 $c->response->body('');
901 return $c->response->status;
904 =item $c->finalize_body
910 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
912 =item $c->finalize_cookies
918 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
920 =item $c->finalize_error
926 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
928 =item $c->finalize_headers
934 sub finalize_headers {
937 # Check if we already finalized headers
938 return if $c->response->{_finalized_headers};
941 if ( my $location = $c->response->redirect ) {
942 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
943 $c->response->header( Location => $location );
947 if ( $c->response->body && !$c->response->content_length ) {
948 $c->response->content_length( bytes::length( $c->response->body ) );
952 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
953 $c->response->headers->remove_header("Content-Length");
954 $c->response->body('');
957 $c->finalize_cookies;
959 $c->engine->finalize_headers( $c, @_ );
962 $c->response->{_finalized_headers} = 1;
965 =item $c->finalize_output
967 An alias for finalize_body.
969 =item $c->finalize_read
971 Finalize the input after reading is complete.
975 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
977 =item $c->finalize_uploads
979 Finalize uploads. Cleans up any temporary files.
983 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
985 =item $c->get_action( $action, $namespace )
987 Get an action in a given namespace.
991 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
993 =item $c->get_actions( $action, $namespace )
995 Get all actions of a given name in a namespace and all base namespaces.
999 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1001 =item handle_request( $class, @arguments )
1003 Handles the request.
1007 sub handle_request {
1008 my ( $class, @arguments ) = @_;
1010 # Always expect worst case!
1016 my $c = $class->prepare(@arguments);
1017 $c->{stats} = \@stats;
1019 return $c->finalize;
1022 if ( $class->debug ) {
1024 ( $elapsed, $status ) = $class->benchmark($handler);
1025 $elapsed = sprintf '%f', $elapsed;
1026 my $av = sprintf '%.3f',
1027 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1028 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1030 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1032 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1034 else { $status = &$handler }
1038 if ( my $error = $@ ) {
1040 $class->log->error(qq/Caught exception in engine "$error"/);
1044 $class->log->_flush() if $class->log->can('_flush');
1048 =item $c->prepare(@arguments)
1050 Turns the engine-specific request( Apache, CGI ... )
1051 into a Catalyst context .
1056 my ( $class, @arguments ) = @_;
1061 request => Catalyst::Request->new(
1064 body_parameters => {},
1066 headers => HTTP::Headers->new,
1068 query_parameters => {},
1074 response => Catalyst::Response->new(
1078 headers => HTTP::Headers->new(),
1086 # For on-demand data
1087 $c->request->{_context} = $c;
1088 $c->response->{_context} = $c;
1089 weaken( $c->request->{_context} );
1090 weaken( $c->response->{_context} );
1093 my $secs = time - $START || 1;
1094 my $av = sprintf '%.3f', $COUNT / $secs;
1095 $c->log->debug('**********************************');
1096 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1097 $c->log->debug('**********************************');
1098 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1101 $c->prepare_request(@arguments);
1102 $c->prepare_connection;
1103 $c->prepare_query_parameters;
1104 $c->prepare_headers;
1105 $c->prepare_cookies;
1109 $c->prepare_body unless $c->config->{parse_on_demand};
1112 my $method = $c->req->method || '';
1113 my $path = $c->req->path || '';
1114 my $address = $c->req->address || '';
1116 $c->log->debug(qq/"$method" request for "$path" from $address/)
1122 =item $c->prepare_action
1128 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1130 =item $c->prepare_body
1132 Prepare message body.
1139 # Do we run for the first time?
1140 return if defined $c->request->{_body};
1142 # Initialize on-demand data
1143 $c->engine->prepare_body( $c, @_ );
1144 $c->prepare_parameters;
1145 $c->prepare_uploads;
1147 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1148 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1149 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1150 my $param = $c->req->body_parameters->{$key};
1151 my $value = defined($param) ? $param : '';
1153 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1155 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1159 =item $c->prepare_body_chunk( $chunk )
1161 Prepare a chunk of data before sending it to HTTP::Body.
1165 sub prepare_body_chunk {
1167 $c->engine->prepare_body_chunk( $c, @_ );
1170 =item $c->prepare_body_parameters
1172 Prepare body parameters.
1176 sub prepare_body_parameters {
1178 $c->engine->prepare_body_parameters( $c, @_ );
1181 =item $c->prepare_connection
1187 sub prepare_connection {
1189 $c->engine->prepare_connection( $c, @_ );
1192 =item $c->prepare_cookies
1198 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1200 =item $c->prepare_headers
1206 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1208 =item $c->prepare_parameters
1214 sub prepare_parameters {
1216 $c->prepare_body_parameters;
1217 $c->engine->prepare_parameters( $c, @_ );
1220 =item $c->prepare_path
1222 Prepare path and base.
1226 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1228 =item $c->prepare_query_parameters
1230 Prepare query parameters.
1234 sub prepare_query_parameters {
1237 $c->engine->prepare_query_parameters( $c, @_ );
1239 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1240 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1241 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1242 my $param = $c->req->query_parameters->{$key};
1243 my $value = defined($param) ? $param : '';
1245 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1247 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1251 =item $c->prepare_read
1253 Prepare the input for reading.
1257 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1259 =item $c->prepare_request
1261 Prepare the engine request.
1265 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1267 =item $c->prepare_uploads
1273 sub prepare_uploads {
1276 $c->engine->prepare_uploads( $c, @_ );
1278 if ( $c->debug && keys %{ $c->request->uploads } ) {
1279 my $t = Text::SimpleTable->new(
1285 for my $key ( sort keys %{ $c->request->uploads } ) {
1286 my $upload = $c->request->uploads->{$key};
1287 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1288 $t->row( $key, $u->filename, $u->type, $u->size );
1291 $c->log->debug( "File Uploads are:\n" . $t->draw );
1295 =item $c->prepare_write
1297 Prepare the output for writing.
1301 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1303 =item $c->read( [$maxlength] )
1305 Read a chunk of data from the request body. This method is designed to be
1306 used in a while loop, reading $maxlength bytes on every call. $maxlength
1307 defaults to the size of the request if not specified.
1309 You have to set MyApp->config->{parse_on_demand} to use this directly.
1313 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1321 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1323 =item $c->set_action( $action, $code, $namespace, $attrs )
1325 Set an action in a given namespace.
1329 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1331 =item $c->setup_actions($component)
1333 Setup actions for a component.
1337 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1339 =item $c->setup_components
1345 sub setup_components {
1348 my $callback = sub {
1349 my ( $component, $context ) = @_;
1351 unless ( $component->isa('Catalyst::Component') ) {
1355 my $suffix = Catalyst::Utils::class2classsuffix($class);
1356 my $config = $class->config->{$suffix} || {};
1360 eval { $instance = $component->new( $context, $config ); };
1362 if ( my $error = $@ ) {
1366 Catalyst::Exception->throw( message =>
1367 qq/Couldn't instantiate component "$component", "$error"/ );
1370 Catalyst::Exception->throw( message =>
1371 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1373 unless ref $instance;
1378 Module::Pluggable::Fast->import(
1379 name => '_catalyst_components',
1381 "$class\::Controller", "$class\::C",
1382 "$class\::Model", "$class\::M",
1383 "$class\::View", "$class\::V"
1385 callback => $callback
1389 if ( my $error = $@ ) {
1393 Catalyst::Exception->throw(
1394 message => qq/Couldn't load components "$error"/ );
1397 for my $component ( $class->_catalyst_components($class) ) {
1398 $class->components->{ ref $component || $component } = $component;
1402 =item $c->setup_dispatcher
1406 sub setup_dispatcher {
1407 my ( $class, $dispatcher ) = @_;
1410 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1413 if ( $ENV{CATALYST_DISPATCHER} ) {
1414 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1417 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1419 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1422 unless ($dispatcher) {
1423 $dispatcher = 'Catalyst::Dispatcher';
1426 $dispatcher->require;
1429 Catalyst::Exception->throw(
1430 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1433 # dispatcher instance
1434 $class->dispatcher( $dispatcher->new );
1437 =item $c->setup_engine
1442 my ( $class, $engine ) = @_;
1445 $engine = 'Catalyst::Engine::' . $engine;
1448 if ( $ENV{CATALYST_ENGINE} ) {
1449 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1452 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1453 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1456 if ( !$engine && $ENV{MOD_PERL} ) {
1458 # create the apache method
1461 *{"$class\::apache"} = sub { shift->engine->apache };
1464 my ( $software, $version ) =
1465 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1468 $version =~ s/(\.[^.]+)\./$1/g;
1470 if ( $software eq 'mod_perl' ) {
1472 if ( $version >= 1.99922 ) {
1473 $engine = 'Catalyst::Engine::Apache2::MP20';
1476 elsif ( $version >= 1.9901 ) {
1477 $engine = 'Catalyst::Engine::Apache2::MP19';
1480 elsif ( $version >= 1.24 ) {
1481 $engine = 'Catalyst::Engine::Apache::MP13';
1485 Catalyst::Exception->throw( message =>
1486 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1489 # install the correct mod_perl handler
1490 if ( $version >= 1.9901 ) {
1491 *handler = sub : method {
1492 shift->handle_request(@_);
1496 *handler = sub ($$) { shift->handle_request(@_) };
1501 elsif ( $software eq 'Zeus-Perl' ) {
1502 $engine = 'Catalyst::Engine::Zeus';
1506 Catalyst::Exception->throw(
1507 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1512 $engine = 'Catalyst::Engine::CGI';
1518 Catalyst::Exception->throw( message =>
1519 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1523 # check for old engines that are no longer compatible
1525 if ( $engine->isa('Catalyst::Engine::Apache')
1526 && !Catalyst::Engine::Apache->VERSION )
1531 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1532 && Catalyst::Engine::Server->VERSION le '0.02' )
1537 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1538 && $engine->VERSION eq '0.01' )
1543 elsif ($engine->isa('Catalyst::Engine::Zeus')
1544 && $engine->VERSION eq '0.01' )
1550 Catalyst::Exception->throw( message =>
1551 qq/Engine "$engine" is not supported by this version of Catalyst/
1556 $class->engine( $engine->new );
1559 =item $c->setup_home
1564 my ( $class, $home ) = @_;
1566 if ( $ENV{CATALYST_HOME} ) {
1567 $home = $ENV{CATALYST_HOME};
1570 if ( $ENV{ uc($class) . '_HOME' } ) {
1571 $home = $ENV{ uc($class) . '_HOME' };
1575 $home = Catalyst::Utils::home($class);
1579 $class->config->{home} ||= $home;
1580 $class->config->{root} ||= dir($home)->subdir('root');
1589 my ( $class, $debug ) = @_;
1591 unless ( $class->log ) {
1592 $class->log( Catalyst::Log->new );
1595 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1598 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1599 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1604 *{"$class\::debug"} = sub { 1 };
1605 $class->log->debug('Debug messages enabled');
1609 =item $c->setup_plugins
1614 my ( $class, $plugins ) = @_;
1617 for my $plugin ( reverse @$plugins ) {
1619 $plugin = "Catalyst::Plugin::$plugin";
1624 Catalyst::Exception->throw(
1625 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1630 unshift @{"$class\::ISA"}, $plugin;
1635 =item $c->write( $data )
1637 Writes $data to the output stream. When using this method directly, you will
1638 need to manually set the Content-Length header to the length of your output
1646 # Finalize headers if someone manually writes output
1647 $c->finalize_headers;
1649 return $c->engine->write( $c, @_ );
1654 Returns the Catalyst version number. mostly useful for powered by messages
1655 in template systems.
1659 sub version { return $Catalyst::VERSION }
1663 =head1 INTERNAL ACTIONS
1665 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1666 C<_ACTION> and C<_END>, these are by default not shown in the private
1669 But you can deactivate this with a config parameter.
1671 MyApp->config->{show_internal_actions} = 1;
1673 =head1 CASE SENSITIVITY
1675 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1678 But you can activate case sensitivity with a config parameter.
1680 MyApp->config->{case_sensitive} = 1;
1682 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1684 =head1 ON-DEMAND PARSER
1686 The request body is usually parsed at the beginning of a request,
1687 but if you want to handle input yourself or speed things up a bit
1688 you can enable on-demand parsing with a config parameter.
1690 MyApp->config->{parse_on_demand} = 1;
1692 =head1 PROXY SUPPORT
1694 Many production servers operate using the common double-server approach, with
1695 a lightweight frontend web server passing requests to a larger backend
1696 server. An application running on the backend server must deal with two
1697 problems: the remote user always appears to be '127.0.0.1' and the server's
1698 hostname will appear to be 'localhost' regardless of the virtual host the
1699 user connected through.
1701 Catalyst will automatically detect this situation when you are running both
1702 the frontend and backend servers on the same machine. The following changes
1703 are made to the request.
1705 $c->req->address is set to the user's real IP address, as read from the
1706 HTTP_X_FORWARDED_FOR header.
1708 The host value for $c->req->base and $c->req->uri is set to the real host,
1709 as read from the HTTP_X_FORWARDED_HOST header.
1711 Obviously, your web server must support these 2 headers for this to work.
1713 In a more complex server farm environment where you may have your frontend
1714 proxy server(s) on different machines, you will need to set a configuration
1715 option to tell Catalyst to read the proxied data from the headers.
1717 MyApp->config->{using_frontend_proxy} = 1;
1719 If you do not wish to use the proxy support at all, you may set:
1721 MyApp->config->{ignore_frontend_proxy} = 1;
1723 =head1 THREAD SAFETY
1725 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1726 and the standalone forking HTTP server on Windows. We believe the Catalyst
1727 core to be thread-safe.
1729 If you plan to operate in a threaded environment, remember that all other
1730 modules you are using must also be thread-safe. Some modules, most notably
1731 DBD::SQLite, are not thread-safe.
1737 Join #catalyst on irc.perl.org.
1741 http://lists.rawmode.org/mailman/listinfo/catalyst
1742 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1746 http://catalyst.perl.org
1752 =item L<Catalyst::Manual> - The Catalyst Manual
1754 =item L<Catalyst::Engine> - Core Engine
1756 =item L<Catalyst::Log> - The Log Class.
1758 =item L<Catalyst::Request> - The Request Object
1760 =item L<Catalyst::Response> - The Response Object
1762 =item L<Catalyst::Test> - The test suite.
1826 Sebastian Riedel, C<sri@oook.de>
1830 This library is free software, you can redistribute it and/or modify it under
1831 the same terms as Perl itself.