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/;
21 __PACKAGE__->mk_accessors(
22 qw/counter depth request response state action namespace/
25 attributes->import(__PACKAGE__, \&namespace, 'lvalue');
32 # For backwards compatibility
33 *finalize_output = \&finalize_body;
38 our $RECURSION = 1000;
39 our $DETACH = "catalyst_detach\n";
41 require Module::Pluggable::Fast;
43 # Helper script generation
44 our $CATALYST_SCRIPT_GEN = 10;
46 __PACKAGE__->mk_classdata($_)
47 for qw/components arguments dispatcher engine log/;
49 our $VERSION = '5.49_03';
52 my ( $class, @arguments ) = @_;
54 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
56 return unless $class eq 'Catalyst';
58 my $caller = caller(0);
60 unless ( $caller->isa('Catalyst') ) {
62 push @{"$caller\::ISA"}, $class;
65 $caller->arguments( [@arguments] );
71 Catalyst - The Elegant MVC Web Application Framework
75 # use the helper to start a new application
79 # add models, views, controllers
80 script/myapp_create.pl model Something
81 script/myapp_create.pl view Stuff
82 script/myapp_create.pl controller Yada
85 script/myapp_server.pl
87 # command line interface
88 script/myapp_test.pl /yada
93 use Catalyst qw/My::Module My::OtherModule/;
95 use Catalyst '-Debug';
97 use Catalyst qw/-Debug -Engine=CGI/;
99 sub default : Private { $_[1]->res->output('Hello') } );
101 sub index : Path('/index.html') {
102 my ( $self, $c ) = @_;
103 $c->res->output('Hello');
107 sub product : Regex('^product[_]*(\d*).html$') {
108 my ( $self, $c ) = @_;
109 $c->stash->{template} = 'product.tt';
110 $c->stash->{product} = $c->req->snippets->[0];
113 See also L<Catalyst::Manual::Intro>
117 The key concept of Catalyst is DRY (Don't Repeat Yourself).
119 See L<Catalyst::Manual> for more documentation.
121 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
122 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
123 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
125 use Catalyst 'My::Module';
127 Special flags like -Debug and -Engine can also be specified as arguments when
130 use Catalyst qw/-Debug My::Module/;
132 The position of plugins and flags in the chain is important, because they are
133 loaded in exactly the order that they appear.
135 The following flags are supported:
141 enables debug output, i.e.:
143 use Catalyst '-Debug';
145 this is equivalent to:
152 Force Catalyst to use a specific dispatcher.
156 Force Catalyst to use a specific engine.
157 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
159 use Catalyst '-Engine=CGI';
163 Force Catalyst to use a specific home directory.
177 Accessor for the current action
179 =item $c->comp($name)
181 =item $c->component($name)
183 Get a component object by name.
185 $c->comp('MyApp::Model::MyModel')->do_stuff;
196 my $appclass = ref $c || $c;
199 $name, "${appclass}::${name}",
200 map { "${appclass}::${_}::${name}" } qw/M V C/
203 foreach my $try (@names) {
205 if ( exists $c->components->{$try} ) {
207 return $c->components->{$try};
211 foreach my $component ( keys %{ $c->components } ) {
213 return $c->components->{$component} if $component =~ /$name/i;
218 return sort keys %{ $c->components };
223 Returns a hashref containing your applications settings.
227 =item $c->controller($name)
229 Get a L<Catalyst::Controller> instance by name.
231 $c->controller('Foo')->do_stuff;
236 my ( $c, $name ) = @_;
237 my $controller = $c->comp("Controller::$name");
238 return $controller if $controller;
239 return $c->comp("C::$name");
244 Overload to enable debug messages.
250 =item $c->detach( $command [, \@arguments ] )
252 Like C<forward> but doesn't return.
256 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
260 Contains the dispatcher instance.
261 Stringifies to class.
263 =item $c->forward( $command [, \@arguments ] )
265 Forward processing to a private action or a method from a class.
266 If you define a class without method it will default to process().
267 also takes an optional arrayref containing arguments to be passed
268 to the new function. $c->req->args will be reset upon returning
272 $c->forward('index');
273 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
274 $c->forward('MyApp::View::TT');
278 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
280 =item $c->model($name)
282 Get a L<Catalyst::Model> instance by name.
284 $c->model('Foo')->do_stuff;
289 my ( $c, $name ) = @_;
290 my $model = $c->comp("Model::$name");
291 return $model if $model;
292 return $c->comp("M::$name");
297 Accessor to the namespace of the current action
299 =item $c->path_to(@path)
301 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
305 $c->path_to( 'db', 'sqlite.db' );
310 my ( $c, @path ) = @_;
311 my $path = dir( $c->config->{home}, @path );
312 if ( -d $path ) { return $path }
313 else { return file( $c->config->{home}, @path ) }
325 my ( $class, @arguments ) = @_;
327 unless ( $class->isa('Catalyst') ) {
329 Catalyst::Exception->throw(
330 message => qq/'$class' does not inherit from Catalyst/ );
333 if ( $class->arguments ) {
334 @arguments = ( @arguments, @{ $class->arguments } );
340 foreach (@arguments) {
344 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
346 elsif (/^-(\w+)=?(.*)$/) {
347 $flags->{ lc $1 } = $2;
350 push @{ $flags->{plugins} }, $_;
354 $class->setup_log( delete $flags->{log} );
355 $class->setup_plugins( delete $flags->{plugins} );
356 $class->setup_dispatcher( delete $flags->{dispatcher} );
357 $class->setup_engine( delete $flags->{engine} );
358 $class->setup_home( delete $flags->{home} );
360 for my $flag ( sort keys %{$flags} ) {
362 if ( my $code = $class->can( 'setup_' . $flag ) ) {
363 &$code( $class, delete $flags->{$flag} );
366 $class->log->warn(qq/Unknown flag "$flag"/);
370 $class->log->warn( "You are running an old helper script! "
371 . "Please update your scripts by regenerating the "
372 . "application and copying over the new scripts." )
373 if ( $ENV{CATALYST_SCRIPT_GEN}
374 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
376 if ( $class->debug ) {
382 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
386 my $t = Text::SimpleTable->new(76);
387 $t->row($_) for @plugins;
388 $class->log->debug( "Loaded plugins:\n" . $t->draw );
391 my $dispatcher = $class->dispatcher;
392 my $engine = $class->engine;
393 my $home = $class->config->{home};
395 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
396 $class->log->debug(qq/Loaded engine "$engine"/);
400 ? $class->log->debug(qq/Found home "$home"/)
401 : $class->log->debug(qq/Home "$home" doesn't exist/)
402 : $class->log->debug(q/Couldn't find home/);
407 no warnings qw/redefine/;
408 local *setup = sub { };
412 # Initialize our data structure
413 $class->components( {} );
415 $class->setup_components;
417 if ( $class->debug ) {
418 my $t = Text::SimpleTable->new(76);
419 $t->row($_) for sort keys %{ $class->components };
420 $class->log->debug( "Loaded components:\n" . $t->draw )
421 if ( keys %{ $class->components } );
424 # Add our self to components, since we are also a component
425 $class->components->{$class} = $class;
427 $class->setup_actions;
429 if ( $class->debug ) {
430 my $name = $class->config->{name} || 'Application';
431 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
433 $class->log->_flush() if $class->log->can('_flush');
436 =item $c->uri_for($path,[@args])
438 Merges path with $c->request->base for absolute uri's and with
439 $c->request->match for relative uri's, then returns a normalized
440 L<URI> object. If any args are passed, they are added at the end
446 my ( $c, $path, @args ) = @_;
447 my $base = $c->request->base->clone;
448 my $basepath = $base->path;
449 $basepath =~ s/\/$//;
451 my $match = $c->request->match;
453 # massage match, empty if absolute path
455 $match .= '/' if $match;
457 $match = '' if $path =~ /^\//;
460 # join args with '/', or a blank string
461 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
462 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
468 =item $c->error($error, ...)
470 =item $c->error($arrayref)
472 Returns an arrayref containing error messages.
474 my @error = @{ $c->error };
478 $c->error('Something bad happened');
489 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
490 push @{ $c->{error} }, @$error;
492 elsif ( defined $_[0] ) { $c->{error} = undef }
493 return $c->{error} || [];
498 Contains the engine instance.
499 Stringifies to the class.
503 Contains the logging object. Unless it is already set Catalyst sets this up with a
504 C<Catalyst::Log> object. To use your own log class:
506 $c->log( MyLogger->new );
507 $c->log->info("now logging with my own logger!");
509 Your log class should implement the methods described in the C<Catalyst::Log>
512 =item $c->plugin( $name, $class, @args )
514 Instant plugins for Catalyst.
515 Classdata accessor/mutator will be created, class loaded and instantiated.
517 MyApp->plugin( 'prototype', 'HTML::Prototype' );
519 $c->prototype->define_javascript_functions;
524 my ( $class, $name, $plugin, @args ) = @_;
527 if ( my $error = $UNIVERSAL::require::ERROR ) {
528 Catalyst::Exception->throw(
529 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
532 eval { $plugin->import };
533 $class->mk_classdata($name);
535 eval { $obj = $plugin->new(@args) };
538 Catalyst::Exception->throw( message =>
539 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
543 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
551 Returns a C<Catalyst::Request> object.
559 Returns a C<Catalyst::Response> object.
565 Contains the return value of the last executed action.
569 Returns a hashref containing all your data.
571 print $c->stash->{foo};
573 Keys may be set in the stash by assigning to the hash reference, or by passing
574 either a single hash reference or a list of key/value pairs as arguments.
578 $c->stash->{foo} ||= 'yada';
579 $c->stash( { moose => 'majestic', qux => 0 } );
580 $c->stash( bar => 1, gorch => 2 );
587 my $stash = @_ > 1 ? {@_} : $_[0];
588 while ( my ( $key, $val ) = each %$stash ) {
589 $c->{stash}->{$key} = $val;
595 =item $c->view($name)
597 Get a L<Catalyst::View> instance by name.
599 $c->view('Foo')->do_stuff;
604 my ( $c, $name ) = @_;
605 my $view = $c->comp("View::$name");
606 return $view if $view;
607 return $c->comp("V::$name");
610 =item $c->welcome_message
612 Returns the Catalyst welcome HTML page.
616 sub welcome_message {
618 my $name = $c->config->{name};
619 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
620 my $prefix = Catalyst::Utils::appprefix( ref $c );
621 $c->response->content_type('text/html; charset=utf-8');
623 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
624 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
625 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
627 <meta http-equiv="Content-Language" content="en" />
628 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
629 <title>$name on Catalyst $VERSION</title>
630 <style type="text/css">
633 background-color: #eee;
642 background-color: #ccc;
643 border: 1px solid #aaa;
644 -moz-border-radius: 10px;
649 font-family: verdana, tahoma, sans-serif;
652 font-family: verdana, tahoma, sans-serif;
655 text-decoration: none;
657 border-bottom: 1px dotted #bbb;
659 :link:hover, :visited:hover {
672 background-color: #fff;
673 border: 1px solid #aaa;
674 -moz-border-radius: 10px;
700 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
705 <img src="$logo" alt="Catalyst Logo" />
707 <p>Welcome to the wonderful world of Catalyst.
708 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
709 framework will make web development something you had
710 never expected it to be: Fun, rewarding and quick.</p>
711 <h2>What to do now?</h2>
712 <p>That really depends on what <b>you</b> want to do.
713 We do, however, provide you with a few starting points.</p>
714 <p>If you want to jump right into web development with Catalyst
715 you might want to check out the documentation.</p>
716 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
717 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
718 <h2>What to do next?</h2>
719 <p>Next it's time to write an actual application. Use the
720 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
721 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
722 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
723 they can save you a lot of work.</p>
724 <pre><code>script/${prefix}_create.pl -help</code></pre>
725 <p>Also, be sure to check out the vast and growing
726 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
727 you are likely to find what you need there.
731 <p>Catalyst has a very active community. Here are the main places to
732 get in touch with us.</p>
735 <a href="http://dev.catalyst.perl.org">Wiki</a>
738 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
741 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
744 <h2>In conclusion</h2>
745 <p>The Catalyst team hopes you will enjoy using Catalyst as much
746 as we enjoyed making it. Please contact us if you have ideas
747 for improvement or other feedback.</p>
757 =head1 INTERNAL METHODS
761 =item $c->benchmark($coderef)
763 Takes a coderef with arguments and returns elapsed time as float.
765 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
766 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
773 my $time = [gettimeofday];
774 my @return = &$code(@_);
775 my $elapsed = tv_interval $time;
776 return wantarray ? ( $elapsed, @return ) : $elapsed;
781 Contains the components.
785 Returns a hashref containing coderefs and execution counts.
786 (Needed for deep recursion detection)
790 Returns the actual forward depth.
794 Dispatch request to actions.
798 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
802 Returns a list of 2-element array references (name, structure) pairs that will
803 be dumped on the error page in debug mode.
809 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
812 =item $c->execute($class, $coderef)
814 Execute a coderef in given class and catch exceptions.
815 Errors are available via $c->error.
820 my ( $c, $class, $code ) = @_;
821 $class = $c->components->{$class} || $class;
823 my $callsub = ( caller(1) )[3];
828 $action = "/$action" unless $action =~ /\-\>/;
829 $c->counter->{"$code"}++;
831 if ( $c->counter->{"$code"} > $RECURSION ) {
832 my $error = qq/Deep recursion detected in "$action"/;
833 $c->log->error($error);
839 $action = "-> $action" if $callsub =~ /forward$/;
845 my ( $elapsed, @state ) =
846 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
847 unless ( ( $code->name =~ /^_.*/ )
848 && ( !$c->config->{show_internal_actions} ) )
850 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
855 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
860 if ( my $error = $@ ) {
862 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
864 unless ( ref $error ) {
866 $error = qq/Caught exception "$error"/;
884 for my $error ( @{ $c->error } ) {
885 $c->log->error($error);
888 $c->finalize_uploads;
891 if ( $#{ $c->error } >= 0 ) {
895 $c->finalize_headers;
898 if ( $c->request->method eq 'HEAD' ) {
899 $c->response->body('');
904 return $c->response->status;
907 =item $c->finalize_body
913 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
915 =item $c->finalize_cookies
921 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
923 =item $c->finalize_error
929 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
931 =item $c->finalize_headers
937 sub finalize_headers {
940 # Check if we already finalized headers
941 return if $c->response->{_finalized_headers};
944 if ( my $location = $c->response->redirect ) {
945 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
946 $c->response->header( Location => $location );
950 if ( $c->response->body && !$c->response->content_length ) {
951 $c->response->content_length( bytes::length( $c->response->body ) );
955 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
956 $c->response->headers->remove_header("Content-Length");
957 $c->response->body('');
960 $c->finalize_cookies;
962 $c->engine->finalize_headers( $c, @_ );
965 $c->response->{_finalized_headers} = 1;
968 =item $c->finalize_output
970 An alias for finalize_body.
972 =item $c->finalize_read
974 Finalize the input after reading is complete.
978 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
980 =item $c->finalize_uploads
982 Finalize uploads. Cleans up any temporary files.
986 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
988 =item $c->get_action( $action, $namespace )
990 Get an action in a given namespace.
994 sub get_action { my $c = shift; $c->dispatcher->get_action( @_ ) }
996 =item $c->get_actions( $action, $namespace )
998 Get all actions of a given name in a namespace and all base namespaces.
1002 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1004 =item handle_request( $class, @arguments )
1006 Handles the request.
1010 sub handle_request {
1011 my ( $class, @arguments ) = @_;
1013 # Always expect worst case!
1019 my $c = $class->prepare(@arguments);
1020 $c->{stats} = \@stats;
1022 return $c->finalize;
1025 if ( $class->debug ) {
1027 ( $elapsed, $status ) = $class->benchmark($handler);
1028 $elapsed = sprintf '%f', $elapsed;
1029 my $av = sprintf '%.3f',
1030 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1031 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1033 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1035 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1037 else { $status = &$handler }
1041 if ( my $error = $@ ) {
1043 $class->log->error(qq/Caught exception in engine "$error"/);
1047 $class->log->_flush() if $class->log->can('_flush');
1051 =item $c->prepare(@arguments)
1053 Turns the engine-specific request( Apache, CGI ... )
1054 into a Catalyst context .
1059 my ( $class, @arguments ) = @_;
1064 request => Catalyst::Request->new(
1067 body_parameters => {},
1069 headers => HTTP::Headers->new,
1071 query_parameters => {},
1077 response => Catalyst::Response->new(
1081 headers => HTTP::Headers->new(),
1089 # For on-demand data
1090 $c->request->{_context} = $c;
1091 $c->response->{_context} = $c;
1092 weaken( $c->request->{_context} );
1093 weaken( $c->response->{_context} );
1096 my $secs = time - $START || 1;
1097 my $av = sprintf '%.3f', $COUNT / $secs;
1098 $c->log->debug('**********************************');
1099 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1100 $c->log->debug('**********************************');
1101 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1104 $c->prepare_request(@arguments);
1105 $c->prepare_connection;
1106 $c->prepare_query_parameters;
1107 $c->prepare_headers;
1108 $c->prepare_cookies;
1112 $c->prepare_body unless $c->config->{parse_on_demand};
1115 my $method = $c->req->method || '';
1116 my $path = $c->req->path || '';
1117 my $address = $c->req->address || '';
1119 $c->log->debug(qq/"$method" request for "$path" from $address/)
1125 =item $c->prepare_action
1131 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1133 =item $c->prepare_body
1135 Prepare message body.
1142 # Do we run for the first time?
1143 return if defined $c->request->{_body};
1145 # Initialize on-demand data
1146 $c->engine->prepare_body( $c, @_ );
1147 $c->prepare_parameters;
1148 $c->prepare_uploads;
1150 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1151 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1152 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1153 my $param = $c->req->body_parameters->{$key};
1154 my $value = defined($param) ? $param : '';
1156 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1158 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1162 =item $c->prepare_body_chunk( $chunk )
1164 Prepare a chunk of data before sending it to HTTP::Body.
1168 sub prepare_body_chunk {
1170 $c->engine->prepare_body_chunk( $c, @_ );
1173 =item $c->prepare_body_parameters
1175 Prepare body parameters.
1179 sub prepare_body_parameters {
1181 $c->engine->prepare_body_parameters( $c, @_ );
1184 =item $c->prepare_connection
1190 sub prepare_connection {
1192 $c->engine->prepare_connection( $c, @_ );
1195 =item $c->prepare_cookies
1201 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1203 =item $c->prepare_headers
1209 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1211 =item $c->prepare_parameters
1217 sub prepare_parameters {
1219 $c->prepare_body_parameters;
1220 $c->engine->prepare_parameters( $c, @_ );
1223 =item $c->prepare_path
1225 Prepare path and base.
1229 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1231 =item $c->prepare_query_parameters
1233 Prepare query parameters.
1237 sub prepare_query_parameters {
1240 $c->engine->prepare_query_parameters( $c, @_ );
1242 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1243 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1244 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1245 my $param = $c->req->query_parameters->{$key};
1246 my $value = defined($param) ? $param : '';
1248 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1250 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1254 =item $c->prepare_read
1256 Prepare the input for reading.
1260 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1262 =item $c->prepare_request
1264 Prepare the engine request.
1268 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1270 =item $c->prepare_uploads
1276 sub prepare_uploads {
1279 $c->engine->prepare_uploads( $c, @_ );
1281 if ( $c->debug && keys %{ $c->request->uploads } ) {
1282 my $t = Text::SimpleTable->new(
1288 for my $key ( sort keys %{ $c->request->uploads } ) {
1289 my $upload = $c->request->uploads->{$key};
1290 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1291 $t->row( $key, $u->filename, $u->type, $u->size );
1294 $c->log->debug( "File Uploads are:\n" . $t->draw );
1298 =item $c->prepare_write
1300 Prepare the output for writing.
1304 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1306 =item $c->read( [$maxlength] )
1308 Read a chunk of data from the request body. This method is designed to be
1309 used in a while loop, reading $maxlength bytes on every call. $maxlength
1310 defaults to the size of the request if not specified.
1312 You have to set MyApp->config->{parse_on_demand} to use this directly.
1316 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1324 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1326 =item $c->set_action( $action, $code, $namespace, $attrs )
1328 Set an action in a given namespace.
1332 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1334 =item $c->setup_actions($component)
1336 Setup actions for a component.
1340 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1342 =item $c->setup_components
1348 sub setup_components {
1351 my $callback = sub {
1352 my ( $component, $context ) = @_;
1354 unless ( $component->isa('Catalyst::Component') ) {
1358 my $suffix = Catalyst::Utils::class2classsuffix($class);
1359 my $config = $class->config->{$suffix} || {};
1363 eval { $instance = $component->new( $context, $config ); };
1365 if ( my $error = $@ ) {
1369 Catalyst::Exception->throw( message =>
1370 qq/Couldn't instantiate component "$component", "$error"/ );
1373 Catalyst::Exception->throw( message =>
1374 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1376 unless ref $instance;
1381 Module::Pluggable::Fast->import(
1382 name => '_catalyst_components',
1384 "$class\::Controller", "$class\::C",
1385 "$class\::Model", "$class\::M",
1386 "$class\::View", "$class\::V"
1388 callback => $callback
1392 if ( my $error = $@ ) {
1396 Catalyst::Exception->throw(
1397 message => qq/Couldn't load components "$error"/ );
1400 for my $component ( $class->_catalyst_components($class) ) {
1401 $class->components->{ ref $component || $component } = $component;
1405 =item $c->setup_dispatcher
1409 sub setup_dispatcher {
1410 my ( $class, $dispatcher ) = @_;
1413 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1416 if ( $ENV{CATALYST_DISPATCHER} ) {
1417 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1420 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1422 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1425 unless ($dispatcher) {
1426 $dispatcher = 'Catalyst::Dispatcher';
1429 $dispatcher->require;
1432 Catalyst::Exception->throw(
1433 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1436 # dispatcher instance
1437 $class->dispatcher( $dispatcher->new );
1440 =item $c->setup_engine
1445 my ( $class, $engine ) = @_;
1448 $engine = 'Catalyst::Engine::' . $engine;
1451 if ( $ENV{CATALYST_ENGINE} ) {
1452 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1455 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1456 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1459 if ( !$engine && $ENV{MOD_PERL} ) {
1461 # create the apache method
1464 *{"$class\::apache"} = sub { shift->engine->apache };
1467 my ( $software, $version ) =
1468 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1471 $version =~ s/(\.[^.]+)\./$1/g;
1473 if ( $software eq 'mod_perl' ) {
1475 if ( $version >= 1.99922 ) {
1476 $engine = 'Catalyst::Engine::Apache2::MP20';
1479 elsif ( $version >= 1.9901 ) {
1480 $engine = 'Catalyst::Engine::Apache2::MP19';
1483 elsif ( $version >= 1.24 ) {
1484 $engine = 'Catalyst::Engine::Apache::MP13';
1488 Catalyst::Exception->throw( message =>
1489 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1492 # install the correct mod_perl handler
1493 if ( $version >= 1.9901 ) {
1494 *handler = sub : method {
1495 shift->handle_request(@_);
1499 *handler = sub ($$) { shift->handle_request(@_) };
1504 elsif ( $software eq 'Zeus-Perl' ) {
1505 $engine = 'Catalyst::Engine::Zeus';
1509 Catalyst::Exception->throw(
1510 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1515 $engine = 'Catalyst::Engine::CGI';
1521 Catalyst::Exception->throw( message =>
1522 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1526 # check for old engines that are no longer compatible
1528 if ( $engine->isa('Catalyst::Engine::Apache')
1529 && !Catalyst::Engine::Apache->VERSION )
1534 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1535 && Catalyst::Engine::Server->VERSION le '0.02' )
1540 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1541 && $engine->VERSION eq '0.01' )
1546 elsif ($engine->isa('Catalyst::Engine::Zeus')
1547 && $engine->VERSION eq '0.01' )
1553 Catalyst::Exception->throw( message =>
1554 qq/Engine "$engine" is not supported by this version of Catalyst/
1559 $class->engine( $engine->new );
1562 =item $c->setup_home
1567 my ( $class, $home ) = @_;
1569 if ( $ENV{CATALYST_HOME} ) {
1570 $home = $ENV{CATALYST_HOME};
1573 if ( $ENV{ uc($class) . '_HOME' } ) {
1574 $home = $ENV{ uc($class) . '_HOME' };
1578 $home = Catalyst::Utils::home($class);
1582 $class->config->{home} ||= $home;
1583 $class->config->{root} ||= dir($home)->subdir('root');
1592 my ( $class, $debug ) = @_;
1594 unless ( $class->log ) {
1595 $class->log( Catalyst::Log->new );
1598 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1601 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1602 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1607 *{"$class\::debug"} = sub { 1 };
1608 $class->log->debug('Debug messages enabled');
1612 =item $c->setup_plugins
1617 my ( $class, $plugins ) = @_;
1620 for my $plugin ( reverse @$plugins ) {
1622 $plugin = "Catalyst::Plugin::$plugin";
1627 Catalyst::Exception->throw(
1628 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1633 unshift @{"$class\::ISA"}, $plugin;
1638 =item $c->write( $data )
1640 Writes $data to the output stream. When using this method directly, you will
1641 need to manually set the Content-Length header to the length of your output
1649 # Finalize headers if someone manually writes output
1650 $c->finalize_headers;
1652 return $c->engine->write( $c, @_ );
1657 Returns the Catalyst version number. mostly useful for powered by messages
1658 in template systems.
1662 sub version { return $Catalyst::VERSION }
1666 =head1 INTERNAL ACTIONS
1668 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1669 C<_ACTION> and C<_END>, these are by default not shown in the private
1672 But you can deactivate this with a config parameter.
1674 MyApp->config->{show_internal_actions} = 1;
1676 =head1 CASE SENSITIVITY
1678 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1681 But you can activate case sensitivity with a config parameter.
1683 MyApp->config->{case_sensitive} = 1;
1685 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1687 =head1 ON-DEMAND PARSER
1689 The request body is usually parsed at the beginning of a request,
1690 but if you want to handle input yourself or speed things up a bit
1691 you can enable on-demand parsing with a config parameter.
1693 MyApp->config->{parse_on_demand} = 1;
1695 =head1 PROXY SUPPORT
1697 Many production servers operate using the common double-server approach, with
1698 a lightweight frontend web server passing requests to a larger backend
1699 server. An application running on the backend server must deal with two
1700 problems: the remote user always appears to be '127.0.0.1' and the server's
1701 hostname will appear to be 'localhost' regardless of the virtual host the
1702 user connected through.
1704 Catalyst will automatically detect this situation when you are running both
1705 the frontend and backend servers on the same machine. The following changes
1706 are made to the request.
1708 $c->req->address is set to the user's real IP address, as read from the
1709 HTTP_X_FORWARDED_FOR header.
1711 The host value for $c->req->base and $c->req->uri is set to the real host,
1712 as read from the HTTP_X_FORWARDED_HOST header.
1714 Obviously, your web server must support these 2 headers for this to work.
1716 In a more complex server farm environment where you may have your frontend
1717 proxy server(s) on different machines, you will need to set a configuration
1718 option to tell Catalyst to read the proxied data from the headers.
1720 MyApp->config->{using_frontend_proxy} = 1;
1722 If you do not wish to use the proxy support at all, you may set:
1724 MyApp->config->{ignore_frontend_proxy} = 1;
1726 =head1 THREAD SAFETY
1728 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1729 and the standalone forking HTTP server on Windows. We believe the Catalyst
1730 core to be thread-safe.
1732 If you plan to operate in a threaded environment, remember that all other
1733 modules you are using must also be thread-safe. Some modules, most notably
1734 DBD::SQLite, are not thread-safe.
1740 Join #catalyst on irc.perl.org.
1744 http://lists.rawmode.org/mailman/listinfo/catalyst
1745 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1749 http://catalyst.perl.org
1755 =item L<Catalyst::Manual> - The Catalyst Manual
1757 =item L<Catalyst::Engine> - Core Engine
1759 =item L<Catalyst::Log> - The Log Class.
1761 =item L<Catalyst::Request> - The Request Object
1763 =item L<Catalyst::Response> - The Response Object
1765 =item L<Catalyst::Test> - The test suite.
1833 Sebastian Riedel, C<sri@oook.de>
1837 This library is free software, you can redistribute it and/or modify it under
1838 the same terms as Perl itself.