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 request response state action stack namespace/
25 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
27 sub depth { scalar @{ shift->stack || [] }; }
34 # For backwards compatibility
35 *finalize_output = \&finalize_body;
40 our $RECURSION = 1000;
41 our $DETACH = "catalyst_detach\n";
43 require Module::Pluggable::Fast;
45 # Helper script generation
46 our $CATALYST_SCRIPT_GEN = 11;
48 __PACKAGE__->mk_classdata($_)
49 for qw/components arguments dispatcher engine log dispatcher_class
50 engine_class context_class request_class response_class/;
52 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
53 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
54 __PACKAGE__->request_class('Catalyst::Request');
55 __PACKAGE__->response_class('Catalyst::Response');
57 our $VERSION = '5.49_05';
60 my ( $class, @arguments ) = @_;
62 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
64 return unless $class eq 'Catalyst';
66 my $caller = caller(0);
68 unless ( $caller->isa('Catalyst') ) {
70 push @{"$caller\::ISA"}, $class;
73 $caller->arguments( [@arguments] );
79 Catalyst - The Elegant MVC Web Application Framework
83 # use the helper to start a new application
86 # add models, views, controllers
87 script/myapp_create.pl model Database DBIC dbi:SQLite:/path/to/db
88 script/myapp_create.pl view TT TT
89 script/myapp_create.pl controller Search
91 # built in testserver -- use -r to restart automatically on changes
92 script/myapp_server.pl
94 # command line testing interface
95 script/myapp_test.pl /yada
98 use Catalyst qw/-Debug/; # include plugins here as well
100 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
101 my ( $self, $c, @args ) = @_; # args are qw/on you/ for /foo/on/you
102 $c->stash->{template} = 'foo.tt';
103 # lookup something from db -- stash vars are passed to TT
104 $c->stash->{data} = MyApp::Model::Database::Foo->search;
105 if ( $c->req->params->{bar} ) { # access GET or POST parameters
106 $c->forward( 'bar' ); # process another action
107 # do something else after forward returns
111 # The foo.tt TT template can easily use the stash data from the database
112 [% WHILE (item = data.next) %]
116 # called for /bar/of/soap, /bar/of/soap/10, etc.
117 sub bar : Path('/bar/of/soap') { ... }
119 # called for all actions, from the top-most controller inwards
121 my ( $self, $c ) = @_;
123 $c->res->redirect( '/login' ); # require login
124 return 0; # abort request and go immediately to end()
129 # called after the main action is finished
131 my ( $self, $c ) = @_;
132 if ( scalar @{ $c->error } ) { ... } # handle errors
133 return if $c->res->body; # already have a response
134 $c->forward( 'MyApp::View::TT' ); # render template
137 ### in MyApp/Controller/Foo.pm
138 # called for /foo/bar
139 sub bar : Local { ... }
141 # called for /blargle
142 sub blargle : Global { ... }
144 # an index action matches /foo, but not /foo/1, etc.
145 sub index : Private { ... }
147 ### in MyApp/Controller/Foo/Bar.pm
148 # called for /foo/bar/baz
149 sub baz : Local { ... }
151 # first MyApp auto is called, then Foo auto, then this
152 sub auto : Private { ... }
154 # powerful regular expression paths are also possible
155 sub details : Regex('^product/(\w+)/details$') {
156 my ( $self, $c ) = @_;
157 # extract the (\w+) from the URI
158 my $product = $c->req->snippets->[0];
161 See L<Catalyst::Manual::Intro> for additional information.
165 The key concept of Catalyst is DRY (Don't Repeat Yourself).
167 See L<Catalyst::Manual> for more documentation.
169 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
170 Omit the C<Catalyst::Plugin::> prefix from the plugin name, i.e.,
171 C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
173 use Catalyst qw/My::Module/;
175 Special flags like -Debug and -Engine can also be specified as arguments when
178 use Catalyst qw/-Debug My::Module/;
180 The position of plugins and flags in the chain is important, because they are
181 loaded in exactly the order that they appear.
183 The following flags are supported:
189 Enables debug output.
193 Forces Catalyst to use a specific engine.
194 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
196 use Catalyst qw/-Engine=CGI/;
200 Forces Catalyst to use a specific home directory.
210 =head2 Information about the current request
216 Returns a L<Catalyst::Action> object for the current action, which stringifies to the action name.
220 Returns the namespace of the current action, i.e., the uri prefix corresponding to the
221 controller of the current action.
227 Returns the current L<Catalyst::Request> object.
231 =head2 Processing and response to the current request
235 =item $c->forward( $action [, \@arguments ] )
237 =item $c->forward( $class, $method, [, \@arguments ] )
239 Forwards processing to a private action. If you give a class name but
240 no method, process() is called. You may also optionally pass arguments
241 in an arrayref. The action will receive the arguments in @_ and $c->req->args.
242 Upon returning from the function, $c->req->args will be restored to the previous
246 $c->forward('index');
247 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
248 $c->forward('MyApp::View::TT');
252 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
254 =item $c->detach( $action [, \@arguments ] )
256 =item $c->detach( $class, $method, [, \@arguments ] )
258 The same as C<forward>, but doesn't return.
262 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
266 =item $c->error($error, ...)
268 =item $c->error($arrayref)
270 Returns an arrayref containing error messages.
272 my @error = @{ $c->error };
276 $c->error('Something bad happened');
287 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
288 push @{ $c->{error} }, @$error;
290 elsif ( defined $_[0] ) { $c->{error} = undef }
291 return $c->{error} || [];
298 Returns the current L<Catalyst::Response> object.
302 Returns a hashref to the stash, which may be used to store data and pass it
303 between components. You can also set hash keys by passing arguments. The
304 stash is automatically sent to the view.
306 $c->stash->{foo} = $bar;
307 $c->stash( { moose => 'majestic', qux => 0 } );
308 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
310 # stash is automatically passed to the view for use in a template
311 $c->forward( 'MyApp::V::TT' );
318 my $stash = @_ > 1 ? {@_} : $_[0];
319 while ( my ( $key, $val ) = each %$stash ) {
320 $c->{stash}->{$key} = $val;
328 Contains the return value of the last executed action.
332 =head2 Component Accessors
336 =item $c->comp($name)
338 =item $c->component($name)
340 Gets a component object by name. This method is no longer recommended.
341 $c->controller, $c->model, and $c->view should be used instead.
352 my $appclass = ref $c || $c;
355 $name, "${appclass}::${name}",
356 map { "${appclass}::${_}::${name}" }
357 qw/Model M Controller C View V/
360 foreach my $try (@names) {
362 if ( exists $c->components->{$try} ) {
364 return $c->components->{$try};
368 foreach my $component ( keys %{ $c->components } ) {
370 return $c->components->{$component} if $component =~ /$name/i;
375 return sort keys %{ $c->components };
378 =item $c->controller($name)
380 Gets a L<Catalyst::Controller> instance by name.
382 $c->controller('Foo')->do_stuff;
387 my ( $c, $name ) = @_;
388 my $controller = $c->comp("Controller::$name");
389 return $controller if $controller;
390 return $c->comp("C::$name");
393 =item $c->model($name)
395 Gets a L<Catalyst::Model> instance by name.
397 $c->model('Foo')->do_stuff;
402 my ( $c, $name ) = @_;
403 my $model = $c->comp("Model::$name");
404 return $model if $model;
405 return $c->comp("M::$name");
408 =item $c->view($name)
410 Gets a L<Catalyst::View> instance by name.
412 $c->view('Foo')->do_stuff;
417 my ( $c, $name ) = @_;
418 my $view = $c->comp("View::$name");
419 return $view if $view;
420 return $c->comp("V::$name");
425 =head2 Class data and helper classes
431 Returns or takes a hashref containing the application's configuration.
433 __PACKAGE__->config({ db => 'dsn:SQLite:foo.db' });
437 Overload to enable debug messages (same as -Debug option).
445 Returns the dispatcher instance. Stringifies to class name.
449 Returns the engine instance. Stringifies to the class name.
453 Returns the logging object instance. Unless it is already set, Catalyst sets this up with a
454 L<Catalyst::Log> object. To use your own log class:
456 $c->log( MyLogger->new );
457 $c->log->info( 'now logging with my own logger!' );
459 Your log class should implement the methods described in the L<Catalyst::Log>
466 =head2 Utility methods
470 =item $c->path_to(@path)
472 Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
476 $c->path_to( 'db', 'sqlite.db' );
481 my ( $c, @path ) = @_;
482 my $path = dir( $c->config->{home}, @path );
483 if ( -d $path ) { return $path }
484 else { return file( $c->config->{home}, @path ) }
487 =item $c->plugin( $name, $class, @args )
489 Helper method for plugins. It creates a classdata accessor/mutator and loads
490 and instantiates the given class.
492 MyApp->plugin( 'prototype', 'HTML::Prototype' );
494 $c->prototype->define_javascript_functions;
499 my ( $class, $name, $plugin, @args ) = @_;
502 if ( my $error = $UNIVERSAL::require::ERROR ) {
503 Catalyst::Exception->throw(
504 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
507 eval { $plugin->import };
508 $class->mk_classdata($name);
510 eval { $obj = $plugin->new(@args) };
513 Catalyst::Exception->throw( message =>
514 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
518 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
524 Initializes the dispatcher and engine, loads any plugins, and loads the
525 model, view, and controller components. You may also specify an array of
526 plugins to load here, if you choose to not load them in the C<use Catalyst>
530 MyApp->setup( qw/-Debug/ );
535 my ( $class, @arguments ) = @_;
537 unless ( $class->isa('Catalyst') ) {
539 Catalyst::Exception->throw(
540 message => qq/'$class' does not inherit from Catalyst/ );
543 if ( $class->arguments ) {
544 @arguments = ( @arguments, @{ $class->arguments } );
550 foreach (@arguments) {
554 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
556 elsif (/^-(\w+)=?(.*)$/) {
557 $flags->{ lc $1 } = $2;
560 push @{ $flags->{plugins} }, $_;
564 $class->setup_log( delete $flags->{log} );
565 $class->setup_plugins( delete $flags->{plugins} );
566 $class->setup_dispatcher( delete $flags->{dispatcher} );
567 $class->setup_engine( delete $flags->{engine} );
568 $class->setup_home( delete $flags->{home} );
570 for my $flag ( sort keys %{$flags} ) {
572 if ( my $code = $class->can( 'setup_' . $flag ) ) {
573 &$code( $class, delete $flags->{$flag} );
576 $class->log->warn(qq/Unknown flag "$flag"/);
581 <<"EOF") if ( $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
582 You are running an old script!
584 Please update by running:
585 catalyst.pl -nonew -scripts $class
588 if ( $class->debug ) {
594 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
598 my $t = Text::SimpleTable->new(76);
599 $t->row($_) for @plugins;
600 $class->log->debug( "Loaded plugins:\n" . $t->draw );
603 my $dispatcher = $class->dispatcher;
604 my $engine = $class->engine;
605 my $home = $class->config->{home};
607 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
608 $class->log->debug(qq/Loaded engine "$engine"/);
612 ? $class->log->debug(qq/Found home "$home"/)
613 : $class->log->debug(qq/Home "$home" doesn't exist/)
614 : $class->log->debug(q/Couldn't find home/);
619 no warnings qw/redefine/;
620 local *setup = sub { };
624 # Initialize our data structure
625 $class->components( {} );
627 $class->setup_components;
629 if ( $class->debug ) {
630 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
631 for my $comp ( sort keys %{ $class->components } ) {
632 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
633 $t->row( $comp, $type );
635 $class->log->debug( "Loaded components:\n" . $t->draw )
636 if ( keys %{ $class->components } );
639 # Add our self to components, since we are also a component
640 $class->components->{$class} = $class;
642 $class->setup_actions;
644 if ( $class->debug ) {
645 my $name = $class->config->{name} || 'Application';
646 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
648 $class->log->_flush() if $class->log->can('_flush');
651 =item $c->uri_for( $path, [ @args ] )
653 Merges path with $c->request->base for absolute uri's and with
654 $c->request->match for relative uri's, then returns a normalized
655 L<URI> object. If any args are passed, they are added at the end
661 my ( $c, $path, @args ) = @_;
662 my $base = $c->request->base->clone;
663 my $basepath = $base->path;
664 $basepath =~ s/\/$//;
666 my $match = $c->request->match;
668 # massage match, empty if absolute path
670 $match .= '/' if $match;
672 $match = '' if $path =~ /^\//;
675 # join args with '/', or a blank string
676 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
677 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
681 =item $c->welcome_message
683 Returns the Catalyst welcome HTML page.
687 sub welcome_message {
689 my $name = $c->config->{name};
690 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
691 my $prefix = Catalyst::Utils::appprefix( ref $c );
692 $c->response->content_type('text/html; charset=utf-8');
694 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
695 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
696 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
698 <meta http-equiv="Content-Language" content="en" />
699 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
700 <title>$name on Catalyst $VERSION</title>
701 <style type="text/css">
704 background-color: #eee;
713 background-color: #ccc;
714 border: 1px solid #aaa;
715 -moz-border-radius: 10px;
720 font-family: verdana, tahoma, sans-serif;
723 font-family: verdana, tahoma, sans-serif;
726 text-decoration: none;
728 border-bottom: 1px dotted #bbb;
730 :link:hover, :visited:hover {
743 background-color: #fff;
744 border: 1px solid #aaa;
745 -moz-border-radius: 10px;
771 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
776 <img src="$logo" alt="Catalyst Logo" />
778 <p>Welcome to the wonderful world of Catalyst.
779 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
780 framework will make web development something you had
781 never expected it to be: Fun, rewarding and quick.</p>
782 <h2>What to do now?</h2>
783 <p>That really depends on what <b>you</b> want to do.
784 We do, however, provide you with a few starting points.</p>
785 <p>If you want to jump right into web development with Catalyst
786 you might want to check out the documentation.</p>
787 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
788 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
789 <h2>What to do next?</h2>
790 <p>Next it's time to write an actual application. Use the
791 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
792 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
793 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
794 they can save you a lot of work.</p>
795 <pre><code>script/${prefix}_create.pl -help</code></pre>
796 <p>Also, be sure to check out the vast and growing
797 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
798 you are likely to find what you need there.
802 <p>Catalyst has a very active community. Here are the main places to
803 get in touch with us.</p>
806 <a href="http://dev.catalyst.perl.org">Wiki</a>
809 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
812 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
815 <h2>In conclusion</h2>
816 <p>The Catalyst team hopes you will enjoy using Catalyst as much
817 as we enjoyed making it. Please contact us if you have ideas
818 for improvement or other feedback.</p>
828 =head1 INTERNAL METHODS
832 =item $c->benchmark( $coderef )
834 Takes a coderef with arguments and returns elapsed time as float.
836 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
837 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
844 my $time = [gettimeofday];
845 my @return = &$code(@_);
846 my $elapsed = tv_interval $time;
847 return wantarray ? ( $elapsed, @return ) : $elapsed;
852 Returns a hash of components.
854 =item $c->context_class
856 Returns or sets the context class.
860 Returns a hashref containing coderefs and execution counts (needed for deep
861 recursion detection).
865 Returns the number of actions on the current internal execution stack.
869 Dispatches a request to actions.
873 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
875 =item $c->dispatcher_class
877 Returns or sets the dispatcher class.
881 Returns a list of 2-element array references (name, structure) pairs that will
882 be dumped on the error page in debug mode.
888 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
891 =item $c->engine_class
893 Returns or sets the engine class.
895 =item $c->execute( $class, $coderef )
897 Execute a coderef in given class and catch exceptions. Errors are available
903 my ( $c, $class, $code ) = @_;
904 $class = $c->components->{$class} || $class;
908 ( caller(0) )[0]->isa('Catalyst::Action')
915 $action = "/$action" unless $action =~ /\-\>/;
916 $c->counter->{"$code"}++;
918 if ( $c->counter->{"$code"} > $RECURSION ) {
919 my $error = qq/Deep recursion detected in "$action"/;
920 $c->log->error($error);
926 $action = "-> $action" if $callsub =~ /forward$/;
928 push( @{ $c->stack }, $code );
932 my ( $elapsed, @state ) =
933 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
934 unless ( ( $code->name =~ /^_.*/ )
935 && ( !$c->config->{show_internal_actions} ) )
937 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
942 $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
945 pop( @{ $c->stack } );
947 if ( my $error = $@ ) {
949 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
951 unless ( ref $error ) {
953 $error = qq/Caught exception "$error"/;
964 Finalizes the request.
971 for my $error ( @{ $c->error } ) {
972 $c->log->error($error);
975 $c->finalize_uploads;
978 if ( $#{ $c->error } >= 0 ) {
982 $c->finalize_headers;
985 if ( $c->request->method eq 'HEAD' ) {
986 $c->response->body('');
991 return $c->response->status;
994 =item $c->finalize_body
1000 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1002 =item $c->finalize_cookies
1008 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1010 =item $c->finalize_error
1016 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1018 =item $c->finalize_headers
1024 sub finalize_headers {
1027 # Check if we already finalized headers
1028 return if $c->response->{_finalized_headers};
1031 if ( my $location = $c->response->redirect ) {
1032 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1033 $c->response->header( Location => $location );
1037 if ( $c->response->body && !$c->response->content_length ) {
1038 $c->response->content_length( bytes::length( $c->response->body ) );
1042 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1043 $c->response->headers->remove_header("Content-Length");
1044 $c->response->body('');
1047 $c->finalize_cookies;
1049 $c->engine->finalize_headers( $c, @_ );
1052 $c->response->{_finalized_headers} = 1;
1055 =item $c->finalize_output
1057 An alias for finalize_body.
1059 =item $c->finalize_read
1061 Finalizes the input after reading is complete.
1065 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1067 =item $c->finalize_uploads
1069 Finalizes uploads. Cleans up any temporary files.
1073 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1075 =item $c->get_action( $action, $namespace )
1077 Gets an action in a given namespace.
1081 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1083 =item $c->get_actions( $action, $namespace )
1085 Gets all actions of a given name in a namespace and all parent namespaces.
1089 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1091 =item handle_request( $class, @arguments )
1093 Called to handle each HTTP request.
1097 sub handle_request {
1098 my ( $class, @arguments ) = @_;
1100 # Always expect worst case!
1106 my $c = $class->prepare(@arguments);
1107 $c->{stats} = \@stats;
1109 return $c->finalize;
1112 if ( $class->debug ) {
1114 ( $elapsed, $status ) = $class->benchmark($handler);
1115 $elapsed = sprintf '%f', $elapsed;
1116 my $av = sprintf '%.3f',
1117 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1118 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1120 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1122 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1124 else { $status = &$handler }
1128 if ( my $error = $@ ) {
1130 $class->log->error(qq/Caught exception in engine "$error"/);
1134 $class->log->_flush() if $class->log->can('_flush');
1138 =item $c->prepare( @arguments )
1140 Creates a Catalyst context from an engine-specific request
1141 (Apache, CGI, etc.).
1146 my ( $class, @arguments ) = @_;
1148 $class->context_class( ref $class || $class ) unless $class->context_class;
1149 my $c = $class->context_class->new(
1153 request => $class->request_class->new(
1156 body_parameters => {},
1158 headers => HTTP::Headers->new,
1160 query_parameters => {},
1166 response => $class->response_class->new(
1170 headers => HTTP::Headers->new(),
1179 # For on-demand data
1180 $c->request->{_context} = $c;
1181 $c->response->{_context} = $c;
1182 weaken( $c->request->{_context} );
1183 weaken( $c->response->{_context} );
1186 my $secs = time - $START || 1;
1187 my $av = sprintf '%.3f', $COUNT / $secs;
1188 $c->log->debug('**********************************');
1189 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1190 $c->log->debug('**********************************');
1191 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1194 $c->prepare_request(@arguments);
1195 $c->prepare_connection;
1196 $c->prepare_query_parameters;
1197 $c->prepare_headers;
1198 $c->prepare_cookies;
1202 $c->prepare_body unless $c->config->{parse_on_demand};
1204 my $method = $c->req->method || '';
1205 my $path = $c->req->path || '';
1206 my $address = $c->req->address || '';
1208 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1216 =item $c->prepare_action
1222 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1224 =item $c->prepare_body
1226 Prepares message body.
1233 # Do we run for the first time?
1234 return if defined $c->request->{_body};
1236 # Initialize on-demand data
1237 $c->engine->prepare_body( $c, @_ );
1238 $c->prepare_parameters;
1239 $c->prepare_uploads;
1241 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1242 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1243 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1244 my $param = $c->req->body_parameters->{$key};
1245 my $value = defined($param) ? $param : '';
1247 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1249 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1253 =item $c->prepare_body_chunk( $chunk )
1255 Prepares a chunk of data before sending it to L<HTTP::Body>.
1259 sub prepare_body_chunk {
1261 $c->engine->prepare_body_chunk( $c, @_ );
1264 =item $c->prepare_body_parameters
1266 Prepares body parameters.
1270 sub prepare_body_parameters {
1272 $c->engine->prepare_body_parameters( $c, @_ );
1275 =item $c->prepare_connection
1277 Prepares connection.
1281 sub prepare_connection {
1283 $c->engine->prepare_connection( $c, @_ );
1286 =item $c->prepare_cookies
1292 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1294 =item $c->prepare_headers
1300 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1302 =item $c->prepare_parameters
1304 Prepares parameters.
1308 sub prepare_parameters {
1310 $c->prepare_body_parameters;
1311 $c->engine->prepare_parameters( $c, @_ );
1314 =item $c->prepare_path
1316 Prepares path and base.
1320 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1322 =item $c->prepare_query_parameters
1324 Prepares query parameters.
1328 sub prepare_query_parameters {
1331 $c->engine->prepare_query_parameters( $c, @_ );
1333 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1334 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1335 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1336 my $param = $c->req->query_parameters->{$key};
1337 my $value = defined($param) ? $param : '';
1339 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1341 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1345 =item $c->prepare_read
1347 Prepares the input for reading.
1351 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1353 =item $c->prepare_request
1355 Prepares the engine request.
1359 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1361 =item $c->prepare_uploads
1367 sub prepare_uploads {
1370 $c->engine->prepare_uploads( $c, @_ );
1372 if ( $c->debug && keys %{ $c->request->uploads } ) {
1373 my $t = Text::SimpleTable->new(
1379 for my $key ( sort keys %{ $c->request->uploads } ) {
1380 my $upload = $c->request->uploads->{$key};
1381 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1382 $t->row( $key, $u->filename, $u->type, $u->size );
1385 $c->log->debug( "File Uploads are:\n" . $t->draw );
1389 =item $c->prepare_write
1391 Prepares the output for writing.
1395 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1397 =item $c->request_class
1399 Returns or sets the request class.
1401 =item $c->response_class
1403 Returns or sets the response class.
1405 =item $c->read( [$maxlength] )
1407 Reads a chunk of data from the request body. This method is designed to be
1408 used in a while loop, reading $maxlength bytes on every call. $maxlength
1409 defaults to the size of the request if not specified.
1411 You have to set MyApp->config->{parse_on_demand} to use this directly.
1415 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1423 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1425 =item $c->set_action( $action, $code, $namespace, $attrs )
1427 Sets an action in a given namespace.
1431 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1433 =item $c->setup_actions($component)
1435 Sets up actions for a component.
1439 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1441 =item $c->setup_components
1447 sub setup_components {
1450 my $callback = sub {
1451 my ( $component, $context ) = @_;
1453 unless ( $component->isa('Catalyst::Component') ) {
1457 my $suffix = Catalyst::Utils::class2classsuffix($component);
1458 my $config = $class->config->{$suffix} || {};
1462 eval { $instance = $component->new( $context, $config ); };
1464 if ( my $error = $@ ) {
1468 Catalyst::Exception->throw( message =>
1469 qq/Couldn't instantiate component "$component", "$error"/ );
1472 Catalyst::Exception->throw( message =>
1473 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1475 unless ref $instance;
1480 Module::Pluggable::Fast->import(
1481 name => '_catalyst_components',
1483 "$class\::Controller", "$class\::C",
1484 "$class\::Model", "$class\::M",
1485 "$class\::View", "$class\::V"
1487 callback => $callback
1491 if ( my $error = $@ ) {
1495 Catalyst::Exception->throw(
1496 message => qq/Couldn't load components "$error"/ );
1499 for my $component ( $class->_catalyst_components($class) ) {
1500 $class->components->{ ref $component || $component } = $component;
1504 =item $c->setup_dispatcher
1508 sub setup_dispatcher {
1509 my ( $class, $dispatcher ) = @_;
1512 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1515 if ( $ENV{CATALYST_DISPATCHER} ) {
1516 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1519 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1521 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1524 unless ($dispatcher) {
1525 $dispatcher = $class->dispatcher_class;
1528 $dispatcher->require;
1531 Catalyst::Exception->throw(
1532 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1535 # dispatcher instance
1536 $class->dispatcher( $dispatcher->new );
1539 =item $c->setup_engine
1544 my ( $class, $engine ) = @_;
1547 $engine = 'Catalyst::Engine::' . $engine;
1550 if ( $ENV{CATALYST_ENGINE} ) {
1551 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1554 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1555 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1558 if ( !$engine && $ENV{MOD_PERL} ) {
1560 # create the apache method
1563 *{"$class\::apache"} = sub { shift->engine->apache };
1566 my ( $software, $version ) =
1567 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1570 $version =~ s/(\.[^.]+)\./$1/g;
1572 if ( $software eq 'mod_perl' ) {
1574 if ( $version >= 1.99922 ) {
1575 $engine = 'Catalyst::Engine::Apache2::MP20';
1578 elsif ( $version >= 1.9901 ) {
1579 $engine = 'Catalyst::Engine::Apache2::MP19';
1582 elsif ( $version >= 1.24 ) {
1583 $engine = 'Catalyst::Engine::Apache::MP13';
1587 Catalyst::Exception->throw( message =>
1588 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1591 # install the correct mod_perl handler
1592 if ( $version >= 1.9901 ) {
1593 *handler = sub : method {
1594 shift->handle_request(@_);
1598 *handler = sub ($$) { shift->handle_request(@_) };
1603 elsif ( $software eq 'Zeus-Perl' ) {
1604 $engine = 'Catalyst::Engine::Zeus';
1608 Catalyst::Exception->throw(
1609 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1614 $engine = $class->engine_class;
1620 Catalyst::Exception->throw( message =>
1621 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1625 # check for old engines that are no longer compatible
1627 if ( $engine->isa('Catalyst::Engine::Apache')
1628 && !Catalyst::Engine::Apache->VERSION )
1633 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1634 && Catalyst::Engine::Server->VERSION le '0.02' )
1639 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1640 && $engine->VERSION eq '0.01' )
1645 elsif ($engine->isa('Catalyst::Engine::Zeus')
1646 && $engine->VERSION eq '0.01' )
1652 Catalyst::Exception->throw( message =>
1653 qq/Engine "$engine" is not supported by this version of Catalyst/
1658 $class->engine( $engine->new );
1661 =item $c->setup_home
1666 my ( $class, $home ) = @_;
1668 if ( $ENV{CATALYST_HOME} ) {
1669 $home = $ENV{CATALYST_HOME};
1672 if ( $ENV{ uc($class) . '_HOME' } ) {
1673 $home = $ENV{ uc($class) . '_HOME' };
1677 $home = Catalyst::Utils::home($class);
1681 $class->config->{home} ||= $home;
1682 $class->config->{root} ||= dir($home)->subdir('root');
1691 my ( $class, $debug ) = @_;
1693 unless ( $class->log ) {
1694 $class->log( Catalyst::Log->new );
1697 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1700 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1701 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1706 *{"$class\::debug"} = sub { 1 };
1707 $class->log->debug('Debug messages enabled');
1711 =item $c->setup_plugins
1716 my ( $class, $plugins ) = @_;
1719 for my $plugin ( reverse @$plugins ) {
1721 $plugin = "Catalyst::Plugin::$plugin";
1726 Catalyst::Exception->throw(
1727 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1732 unshift @{"$class\::ISA"}, $plugin;
1741 =item $c->write( $data )
1743 Writes $data to the output stream. When using this method directly, you will
1744 need to manually set the Content-Length header to the length of your output
1752 # Finalize headers if someone manually writes output
1753 $c->finalize_headers;
1755 return $c->engine->write( $c, @_ );
1760 Returns the Catalyst version number. Mostly useful for "powered by" messages
1761 in template systems.
1765 sub version { return $Catalyst::VERSION }
1769 =head1 INTERNAL ACTIONS
1771 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1772 C<_ACTION> and C<_END>. These are by default not shown in the private
1773 action table, but you can make them visible with a config parameter.
1775 MyApp->config->{show_internal_actions} = 1;
1777 =head1 CASE SENSITIVITY
1779 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
1780 mapped to C</foo/bar>. You can activate case sensitivity with a config
1783 MyApp->config->{case_sensitive} = 1;
1785 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
1787 =head1 ON-DEMAND PARSER
1789 The request body is usually parsed at the beginning of a request,
1790 but if you want to handle input yourself or speed things up a bit,
1791 you can enable on-demand parsing with a config parameter.
1793 MyApp->config->{parse_on_demand} = 1;
1795 =head1 PROXY SUPPORT
1797 Many production servers operate using the common double-server approach, with
1798 a lightweight frontend web server passing requests to a larger backend
1799 server. An application running on the backend server must deal with two
1800 problems: the remote user always appears to be C<127.0.0.1> and the server's
1801 hostname will appear to be C<localhost> regardless of the virtual host that
1802 the user connected through.
1804 Catalyst will automatically detect this situation when you are running the
1805 frontend and backend servers on the same machine. The following changes
1806 are made to the request.
1808 $c->req->address is set to the user's real IP address, as read from the
1809 HTTP X-Forwarded-For header.
1811 The host value for $c->req->base and $c->req->uri is set to the real host,
1812 as read from the HTTP X-Forwarded-Host header.
1814 Obviously, your web server must support these headers for this to work.
1816 In a more complex server farm environment where you may have your frontend
1817 proxy server(s) on different machines, you will need to set a configuration
1818 option to tell Catalyst to read the proxied data from the headers.
1820 MyApp->config->{using_frontend_proxy} = 1;
1822 If you do not wish to use the proxy support at all, you may set:
1824 MyApp->config->{ignore_frontend_proxy} = 1;
1826 =head1 THREAD SAFETY
1828 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1829 and the standalone forking HTTP server on Windows. We believe the Catalyst
1830 core to be thread-safe.
1832 If you plan to operate in a threaded environment, remember that all other
1833 modules you are using must also be thread-safe. Some modules, most notably
1834 L<DBD::SQLite>, are not thread-safe.
1840 Join #catalyst on irc.perl.org.
1844 http://lists.rawmode.org/mailman/listinfo/catalyst
1845 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1849 http://catalyst.perl.org
1853 http://dev.catalyst.perl.org
1859 =item L<Catalyst::Manual> - The Catalyst Manual
1861 =item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1863 =item L<Catalyst::Engine> - Core Engine
1865 =item L<Catalyst::Log> - The Log Class.
1867 =item L<Catalyst::Request> - The Request Object
1869 =item L<Catalyst::Response> - The Response Object
1871 =item L<Catalyst::Test> - The test suite.
1941 Sebastian Riedel, C<sri@oook.de>
1945 This library is free software, you can redistribute it and/or modify it under
1946 the same terms as Perl itself.