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 '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};
1205 my $method = $c->req->method || '';
1206 my $path = $c->req->path || '';
1207 my $address = $c->req->address || '';
1209 $c->log->debug(qq/"$method" request for "$path" from $address/)
1215 =item $c->prepare_action
1221 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1223 =item $c->prepare_body
1225 Prepares message body.
1232 # Do we run for the first time?
1233 return if defined $c->request->{_body};
1235 # Initialize on-demand data
1236 $c->engine->prepare_body( $c, @_ );
1237 $c->prepare_parameters;
1238 $c->prepare_uploads;
1240 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1241 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1242 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1243 my $param = $c->req->body_parameters->{$key};
1244 my $value = defined($param) ? $param : '';
1246 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1248 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1252 =item $c->prepare_body_chunk( $chunk )
1254 Prepares a chunk of data before sending it to L<HTTP::Body>.
1258 sub prepare_body_chunk {
1260 $c->engine->prepare_body_chunk( $c, @_ );
1263 =item $c->prepare_body_parameters
1265 Prepares body parameters.
1269 sub prepare_body_parameters {
1271 $c->engine->prepare_body_parameters( $c, @_ );
1274 =item $c->prepare_connection
1276 Prepares connection.
1280 sub prepare_connection {
1282 $c->engine->prepare_connection( $c, @_ );
1285 =item $c->prepare_cookies
1291 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1293 =item $c->prepare_headers
1299 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1301 =item $c->prepare_parameters
1303 Prepares parameters.
1307 sub prepare_parameters {
1309 $c->prepare_body_parameters;
1310 $c->engine->prepare_parameters( $c, @_ );
1313 =item $c->prepare_path
1315 Prepares path and base.
1319 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1321 =item $c->prepare_query_parameters
1323 Prepares query parameters.
1327 sub prepare_query_parameters {
1330 $c->engine->prepare_query_parameters( $c, @_ );
1332 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1333 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1334 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1335 my $param = $c->req->query_parameters->{$key};
1336 my $value = defined($param) ? $param : '';
1338 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1340 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1344 =item $c->prepare_read
1346 Prepares the input for reading.
1350 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1352 =item $c->prepare_request
1354 Prepares the engine request.
1358 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1360 =item $c->prepare_uploads
1366 sub prepare_uploads {
1369 $c->engine->prepare_uploads( $c, @_ );
1371 if ( $c->debug && keys %{ $c->request->uploads } ) {
1372 my $t = Text::SimpleTable->new(
1378 for my $key ( sort keys %{ $c->request->uploads } ) {
1379 my $upload = $c->request->uploads->{$key};
1380 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1381 $t->row( $key, $u->filename, $u->type, $u->size );
1384 $c->log->debug( "File Uploads are:\n" . $t->draw );
1388 =item $c->prepare_write
1390 Prepares the output for writing.
1394 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1396 =item $c->request_class
1398 Returns or sets the request class.
1400 =item $c->response_class
1402 Returns or sets the response class.
1404 =item $c->read( [$maxlength] )
1406 Reads a chunk of data from the request body. This method is designed to be
1407 used in a while loop, reading $maxlength bytes on every call. $maxlength
1408 defaults to the size of the request if not specified.
1410 You have to set MyApp->config->{parse_on_demand} to use this directly.
1414 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1422 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1424 =item $c->set_action( $action, $code, $namespace, $attrs )
1426 Sets an action in a given namespace.
1430 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1432 =item $c->setup_actions($component)
1434 Sets up actions for a component.
1438 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1440 =item $c->setup_components
1446 sub setup_components {
1449 my $callback = sub {
1450 my ( $component, $context ) = @_;
1452 unless ( $component->isa('Catalyst::Component') ) {
1456 my $suffix = Catalyst::Utils::class2classsuffix($component);
1457 my $config = $class->config->{$suffix} || {};
1461 eval { $instance = $component->new( $context, $config ); };
1463 if ( my $error = $@ ) {
1467 Catalyst::Exception->throw( message =>
1468 qq/Couldn't instantiate component "$component", "$error"/ );
1471 Catalyst::Exception->throw( message =>
1472 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1474 unless ref $instance;
1479 Module::Pluggable::Fast->import(
1480 name => '_catalyst_components',
1482 "$class\::Controller", "$class\::C",
1483 "$class\::Model", "$class\::M",
1484 "$class\::View", "$class\::V"
1486 callback => $callback
1490 if ( my $error = $@ ) {
1494 Catalyst::Exception->throw(
1495 message => qq/Couldn't load components "$error"/ );
1498 for my $component ( $class->_catalyst_components($class) ) {
1499 $class->components->{ ref $component || $component } = $component;
1503 =item $c->setup_dispatcher
1507 sub setup_dispatcher {
1508 my ( $class, $dispatcher ) = @_;
1511 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1514 if ( $ENV{CATALYST_DISPATCHER} ) {
1515 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1518 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1520 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1523 unless ($dispatcher) {
1524 $dispatcher = $class->dispatcher_class;
1527 $dispatcher->require;
1530 Catalyst::Exception->throw(
1531 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1534 # dispatcher instance
1535 $class->dispatcher( $dispatcher->new );
1538 =item $c->setup_engine
1543 my ( $class, $engine ) = @_;
1546 $engine = 'Catalyst::Engine::' . $engine;
1549 if ( $ENV{CATALYST_ENGINE} ) {
1550 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1553 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1554 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1557 if ( !$engine && $ENV{MOD_PERL} ) {
1559 # create the apache method
1562 *{"$class\::apache"} = sub { shift->engine->apache };
1565 my ( $software, $version ) =
1566 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1569 $version =~ s/(\.[^.]+)\./$1/g;
1571 if ( $software eq 'mod_perl' ) {
1573 if ( $version >= 1.99922 ) {
1574 $engine = 'Catalyst::Engine::Apache2::MP20';
1577 elsif ( $version >= 1.9901 ) {
1578 $engine = 'Catalyst::Engine::Apache2::MP19';
1581 elsif ( $version >= 1.24 ) {
1582 $engine = 'Catalyst::Engine::Apache::MP13';
1586 Catalyst::Exception->throw( message =>
1587 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1590 # install the correct mod_perl handler
1591 if ( $version >= 1.9901 ) {
1592 *handler = sub : method {
1593 shift->handle_request(@_);
1597 *handler = sub ($$) { shift->handle_request(@_) };
1602 elsif ( $software eq 'Zeus-Perl' ) {
1603 $engine = 'Catalyst::Engine::Zeus';
1607 Catalyst::Exception->throw(
1608 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1613 $engine = $class->engine_class;
1619 Catalyst::Exception->throw( message =>
1620 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1624 # check for old engines that are no longer compatible
1626 if ( $engine->isa('Catalyst::Engine::Apache')
1627 && !Catalyst::Engine::Apache->VERSION )
1632 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1633 && Catalyst::Engine::Server->VERSION le '0.02' )
1638 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1639 && $engine->VERSION eq '0.01' )
1644 elsif ($engine->isa('Catalyst::Engine::Zeus')
1645 && $engine->VERSION eq '0.01' )
1651 Catalyst::Exception->throw( message =>
1652 qq/Engine "$engine" is not supported by this version of Catalyst/
1657 $class->engine( $engine->new );
1660 =item $c->setup_home
1665 my ( $class, $home ) = @_;
1667 if ( $ENV{CATALYST_HOME} ) {
1668 $home = $ENV{CATALYST_HOME};
1671 if ( $ENV{ uc($class) . '_HOME' } ) {
1672 $home = $ENV{ uc($class) . '_HOME' };
1676 $home = Catalyst::Utils::home($class);
1680 $class->config->{home} ||= $home;
1681 $class->config->{root} ||= dir($home)->subdir('root');
1690 my ( $class, $debug ) = @_;
1692 unless ( $class->log ) {
1693 $class->log( Catalyst::Log->new );
1696 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1699 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1700 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1705 *{"$class\::debug"} = sub { 1 };
1706 $class->log->debug('Debug messages enabled');
1710 =item $c->setup_plugins
1715 my ( $class, $plugins ) = @_;
1718 for my $plugin ( reverse @$plugins ) {
1720 $plugin = "Catalyst::Plugin::$plugin";
1725 Catalyst::Exception->throw(
1726 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1731 unshift @{"$class\::ISA"}, $plugin;
1740 =item $c->write( $data )
1742 Writes $data to the output stream. When using this method directly, you will
1743 need to manually set the Content-Length header to the length of your output
1751 # Finalize headers if someone manually writes output
1752 $c->finalize_headers;
1754 return $c->engine->write( $c, @_ );
1759 Returns the Catalyst version number. Mostly useful for "powered by" messages
1760 in template systems.
1764 sub version { return $Catalyst::VERSION }
1768 =head1 INTERNAL ACTIONS
1770 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
1771 C<_ACTION> and C<_END>, these are by default not shown in the private
1774 But you can deactivate this with a config parameter.
1776 MyApp->config->{show_internal_actions} = 1;
1778 =head1 CASE SENSITIVITY
1780 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1783 But you can activate case sensitivity with a config parameter.
1785 MyApp->config->{case_sensitive} = 1;
1787 So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1789 =head1 ON-DEMAND PARSER
1791 The request body is usually parsed at the beginning of a request,
1792 but if you want to handle input yourself or speed things up a bit
1793 you can enable on-demand parsing with a config parameter.
1795 MyApp->config->{parse_on_demand} = 1;
1797 =head1 PROXY SUPPORT
1799 Many production servers operate using the common double-server approach, with
1800 a lightweight frontend web server passing requests to a larger backend
1801 server. An application running on the backend server must deal with two
1802 problems: the remote user always appears to be '127.0.0.1' and the server's
1803 hostname will appear to be 'localhost' regardless of the virtual host the
1804 user connected through.
1806 Catalyst will automatically detect this situation when you are running both
1807 the frontend and backend servers on the same machine. The following changes
1808 are made to the request.
1810 $c->req->address is set to the user's real IP address, as read from the
1811 HTTP_X_FORWARDED_FOR header.
1813 The host value for $c->req->base and $c->req->uri is set to the real host,
1814 as read from the HTTP_X_FORWARDED_HOST header.
1816 Obviously, your web server must support these 2 headers for this to work.
1818 In a more complex server farm environment where you may have your frontend
1819 proxy server(s) on different machines, you will need to set a configuration
1820 option to tell Catalyst to read the proxied data from the headers.
1822 MyApp->config->{using_frontend_proxy} = 1;
1824 If you do not wish to use the proxy support at all, you may set:
1826 MyApp->config->{ignore_frontend_proxy} = 1;
1828 =head1 THREAD SAFETY
1830 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1831 and the standalone forking HTTP server on Windows. We believe the Catalyst
1832 core to be thread-safe.
1834 If you plan to operate in a threaded environment, remember that all other
1835 modules you are using must also be thread-safe. Some modules, most notably
1836 DBD::SQLite, are not thread-safe.
1842 Join #catalyst on irc.perl.org.
1846 http://lists.rawmode.org/mailman/listinfo/catalyst
1847 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1851 http://catalyst.perl.org
1855 http://dev.catalyst.perl.org
1861 =item L<Catalyst::Manual> - The Catalyst Manual
1863 =item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1865 =item L<Catalyst::Engine> - Core Engine
1867 =item L<Catalyst::Log> - The Log Class.
1869 =item L<Catalyst::Request> - The Request Object
1871 =item L<Catalyst::Response> - The Response Object
1873 =item L<Catalyst::Test> - The test suite.
1943 Sebastian Riedel, C<sri@oook.de>
1947 This library is free software, you can redistribute it and/or modify it under
1948 the same terms as Perl itself.