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/;
22 require Catalyst::Helper;
23 require Catalyst::PAR;
24 require Catalyst::Build;
25 require Catalyst::Test;
27 require Catalyst::Engine::HTTP;
28 require Catalyst::Engine::CGI;
29 require Catalyst::Engine::FastCGI;
31 require Catalyst::Controller;
32 require Catalyst::Model;
33 require Catalyst::View;
35 __PACKAGE__->mk_accessors(
36 qw/counter request response state action stack namespace/
39 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
41 sub depth { scalar @{ shift->stack || [] }; }
48 # For backwards compatibility
49 *finalize_output = \&finalize_body;
54 our $RECURSION = 1000;
55 our $DETACH = "catalyst_detach\n";
57 require Module::Pluggable::Fast;
59 # Helper script generation
60 our $CATALYST_SCRIPT_GEN = 14;
62 __PACKAGE__->mk_classdata($_)
63 for qw/components arguments dispatcher engine log dispatcher_class
64 engine_class context_class request_class response_class/;
66 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
67 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
68 __PACKAGE__->request_class('Catalyst::Request');
69 __PACKAGE__->response_class('Catalyst::Response');
71 our $VERSION = '5.57';
74 my ( $class, @arguments ) = @_;
76 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
78 return unless $class eq 'Catalyst';
80 my $caller = caller(0);
82 unless ( $caller->isa('Catalyst') ) {
84 push @{"$caller\::ISA"}, $class;
87 $caller->arguments( [@arguments] );
93 Catalyst - The Elegant MVC Web Application Framework
97 # use the helper to start a new application
100 # add models, views, controllers
101 script/myapp_create.pl model Database DBIC dbi:SQLite:/path/to/db
102 script/myapp_create.pl view TT TT
103 script/myapp_create.pl controller Search
105 # built in testserver -- use -r to restart automatically on changes
106 script/myapp_server.pl
108 # command line testing interface
109 script/myapp_test.pl /yada
112 use Catalyst qw/-Debug/; # include plugins here as well
114 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
115 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
116 $c->stash->{template} = 'foo.tt'; # set the template
117 # lookup something from db -- stash vars are passed to TT
119 MyApp::Model::Database::Foo->search( { country => $args[0] } );
120 if ( $c->req->params->{bar} ) { # access GET or POST parameters
121 $c->forward( 'bar' ); # process another action
122 # do something else after forward returns
126 # The foo.tt TT template can use the stash data from the database
127 [% WHILE (item = data.next) %]
131 # called for /bar/of/soap, /bar/of/soap/10, etc.
132 sub bar : Path('/bar/of/soap') { ... }
134 # called for all actions, from the top-most controller downwards
136 my ( $self, $c ) = @_;
138 $c->res->redirect( '/login' ); # require login
139 return 0; # abort request and go immediately to end()
141 return 1; # success; carry on to next action
144 # called after all actions are finished
146 my ( $self, $c ) = @_;
147 if ( scalar @{ $c->error } ) { ... } # handle errors
148 return if $c->res->body; # already have a response
149 $c->forward( 'MyApp::View::TT' ); # render template
152 ### in MyApp/Controller/Foo.pm
153 # called for /foo/bar
154 sub bar : Local { ... }
156 # called for /blargle
157 sub blargle : Global { ... }
159 # an index action matches /foo, but not /foo/1, etc.
160 sub index : Private { ... }
162 ### in MyApp/Controller/Foo/Bar.pm
163 # called for /foo/bar/baz
164 sub baz : Local { ... }
166 # first MyApp auto is called, then Foo auto, then this
167 sub auto : Private { ... }
169 # powerful regular expression paths are also possible
170 sub details : Regex('^product/(\w+)/details$') {
171 my ( $self, $c ) = @_;
172 # extract the (\w+) from the URI
173 my $product = $c->req->snippets->[0];
176 See L<Catalyst::Manual::Intro> for additional information.
180 The key concept of Catalyst is DRY (Don't Repeat Yourself).
182 See L<Catalyst::Manual> for more documentation.
184 Catalyst plugins can be loaded by naming them as arguments to the "use
185 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
186 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
189 use Catalyst qw/My::Module/;
191 Special flags like C<-Debug> and C<-Engine> can also be specified as
192 arguments when Catalyst is loaded:
194 use Catalyst qw/-Debug My::Module/;
196 The position of plugins and flags in the chain is important, because
197 they are loaded in exactly the order in which they appear.
199 The following flags are supported:
205 Enables debug output.
209 Forces Catalyst to use a specific engine. Omit the
210 C<Catalyst::Engine::> prefix of the engine name, i.e.:
212 use Catalyst qw/-Engine=CGI/;
216 Forces Catalyst to use a specific home directory, e.g.:
218 use Catalyst qw[-Home=/usr/sri];
228 =head2 Information about the current request
234 Returns a L<Catalyst::Action> object for the current action, which
235 stringifies to the action name. See L<Catalyst::Action>.
239 Returns the namespace of the current action, i.e., the uri prefix
240 corresponding to the controller of the current action. For example:
242 # in Controller::Foo::Bar
243 $c->namespace; # returns 'foo/bar';
249 Returns the current L<Catalyst::Request> object. See
250 L<Catalyst::Request>.
254 =head2 Processing and response to the current request
258 =item $c->forward( $action [, \@arguments ] )
260 =item $c->forward( $class, $method, [, \@arguments ] )
262 Forwards processing to a private action. If you give a class name but no
263 method, C<process()> is called. You may also optionally pass arguments
264 in an arrayref. The action will receive the arguments in C<@_> and
265 C<$c-E<gt>req-E<gt>args>. Upon returning from the function,
266 C<$c-E<gt>req-E<gt>args> will be restored to the previous values.
269 $c->forward('index');
270 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
271 $c->forward('MyApp::View::TT');
275 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
277 =item $c->detach( $action [, \@arguments ] )
279 =item $c->detach( $class, $method, [, \@arguments ] )
281 The same as C<forward>, but doesn't return.
285 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
289 =item $c->error($error, ...)
291 =item $c->error($arrayref)
293 Returns an arrayref containing error messages.
295 my @error = @{ $c->error };
299 $c->error('Something bad happened');
310 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
311 push @{ $c->{error} }, @$error;
313 elsif ( defined $_[0] ) { $c->{error} = undef }
314 return $c->{error} || [];
321 Returns the current L<Catalyst::Response> object.
325 Returns a hashref to the stash, which may be used to store data and pass
326 it between components during a request. You can also set hash keys by
327 passing arguments. The stash is automatically sent to the view. The
328 stash is cleared at the end of a request; it cannot be used for
331 $c->stash->{foo} = $bar;
332 $c->stash( { moose => 'majestic', qux => 0 } );
333 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
335 # stash is automatically passed to the view for use in a template
336 $c->forward( 'MyApp::V::TT' );
343 my $stash = @_ > 1 ? {@_} : $_[0];
344 while ( my ( $key, $val ) = each %$stash ) {
345 $c->{stash}->{$key} = $val;
353 Contains the return value of the last executed action.
357 =head2 Component Accessors
361 =item $c->comp($name)
363 =item $c->component($name)
365 Gets a component object by name. This method is no longer recommended,
366 unless you want to get a specific component by full
367 class. C<$c-E<gt>controller>, C<$c-E<gt>model>, and C<$c-E<gt>view>
368 should be used instead.
379 my $appclass = ref $c || $c;
382 $name, "${appclass}::${name}",
383 map { "${appclass}::${_}::${name}" }
384 qw/Model M Controller C View V/
387 foreach my $try (@names) {
389 if ( exists $c->components->{$try} ) {
391 return $c->components->{$try};
395 foreach my $component ( keys %{ $c->components } ) {
397 return $c->components->{$component} if $component =~ /$name/i;
402 return sort keys %{ $c->components };
405 =item $c->controller($name)
407 Gets a L<Catalyst::Controller> instance by name.
409 $c->controller('Foo')->do_stuff;
414 my ( $c, $name ) = @_;
415 my $controller = $c->comp("Controller::$name");
416 return $controller if $controller;
417 return $c->comp("C::$name");
420 =item $c->model($name)
422 Gets a L<Catalyst::Model> instance by name.
424 $c->model('Foo')->do_stuff;
429 my ( $c, $name ) = @_;
430 my $model = $c->comp("Model::$name");
431 return $model if $model;
432 return $c->comp("M::$name");
435 =item $c->view($name)
437 Gets a L<Catalyst::View> instance by name.
439 $c->view('Foo')->do_stuff;
444 my ( $c, $name ) = @_;
445 my $view = $c->comp("View::$name");
446 return $view if $view;
447 return $c->comp("V::$name");
452 =head2 Class data and helper classes
458 Returns or takes a hashref containing the application's configuration.
460 __PACKAGE__->config({ db => 'dsn:SQLite:foo.db' });
464 Overload to enable debug messages (same as -Debug option).
472 Returns the dispatcher instance. Stringifies to class name. See
473 L<Catalyst::Dispatcher>.
477 Returns the engine instance. Stringifies to the class name. See
482 Returns the logging object instance. Unless it is already set, Catalyst
483 sets this up with a L<Catalyst::Log> object. To use your own log class:
485 $c->log( MyLogger->new );
486 $c->log->info( 'Now logging with my own logger!' );
488 Your log class should implement the methods described in the
489 L<Catalyst::Log> man page.
495 =head2 Utility methods
499 =item $c->path_to(@path)
501 Merges C<@path> with C<$c-E<gt>config-E<gt>{home}> and returns a
502 L<Path::Class> object.
506 $c->path_to( 'db', 'sqlite.db' );
511 my ( $c, @path ) = @_;
512 my $path = dir( $c->config->{home}, @path );
513 if ( -d $path ) { return $path }
514 else { return file( $c->config->{home}, @path ) }
517 =item $c->plugin( $name, $class, @args )
519 Helper method for plugins. It creates a classdata accessor/mutator and
520 loads and instantiates the given class.
522 MyApp->plugin( 'prototype', 'HTML::Prototype' );
524 $c->prototype->define_javascript_functions;
529 my ( $class, $name, $plugin, @args ) = @_;
532 if ( my $error = $UNIVERSAL::require::ERROR ) {
533 Catalyst::Exception->throw(
534 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
537 eval { $plugin->import };
538 $class->mk_classdata($name);
540 eval { $obj = $plugin->new(@args) };
543 Catalyst::Exception->throw( message =>
544 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
548 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
554 Initializes the dispatcher and engine, loads any plugins, and loads the
555 model, view, and controller components. You may also specify an array
556 of plugins to load here, if you choose to not load them in the C<use
560 MyApp->setup( qw/-Debug/ );
565 my ( $class, @arguments ) = @_;
567 unless ( $class->isa('Catalyst') ) {
569 Catalyst::Exception->throw(
570 message => qq/'$class' does not inherit from Catalyst/ );
573 if ( $class->arguments ) {
574 @arguments = ( @arguments, @{ $class->arguments } );
580 foreach (@arguments) {
584 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
586 elsif (/^-(\w+)=?(.*)$/) {
587 $flags->{ lc $1 } = $2;
590 push @{ $flags->{plugins} }, $_;
594 $class->setup_log( delete $flags->{log} );
595 $class->setup_plugins( delete $flags->{plugins} );
596 $class->setup_dispatcher( delete $flags->{dispatcher} );
597 $class->setup_engine( delete $flags->{engine} );
598 $class->setup_home( delete $flags->{home} );
600 for my $flag ( sort keys %{$flags} ) {
602 if ( my $code = $class->can( 'setup_' . $flag ) ) {
603 &$code( $class, delete $flags->{$flag} );
606 $class->log->warn(qq/Unknown flag "$flag"/);
611 <<"EOF") if ( $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
612 You are running an old script!
614 Please update by running:
615 catalyst.pl -nonew -scripts $class
618 if ( $class->debug ) {
624 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
628 my $t = Text::SimpleTable->new(76);
629 $t->row($_) for @plugins;
630 $class->log->debug( "Loaded plugins:\n" . $t->draw );
633 my $dispatcher = $class->dispatcher;
634 my $engine = $class->engine;
635 my $home = $class->config->{home};
637 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
638 $class->log->debug(qq/Loaded engine "$engine"/);
642 ? $class->log->debug(qq/Found home "$home"/)
643 : $class->log->debug(qq/Home "$home" doesn't exist/)
644 : $class->log->debug(q/Couldn't find home/);
649 no warnings qw/redefine/;
650 local *setup = sub { };
654 # Initialize our data structure
655 $class->components( {} );
657 $class->setup_components;
659 if ( $class->debug ) {
660 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
661 for my $comp ( sort keys %{ $class->components } ) {
662 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
663 $t->row( $comp, $type );
665 $class->log->debug( "Loaded components:\n" . $t->draw )
666 if ( keys %{ $class->components } );
669 # Add our self to components, since we are also a component
670 $class->components->{$class} = $class;
672 $class->setup_actions;
674 if ( $class->debug ) {
675 my $name = $class->config->{name} || 'Application';
676 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
678 $class->log->_flush() if $class->log->can('_flush');
681 =item $c->uri_for( $path, [ @args ] )
683 Merges path with C<$c-E<gt>request-E<gt>base> for absolute uri's and
684 with C<$c-E<gt>namespace> for relative uri's, then returns a
685 normalized L<URI> object. If any args are passed, they are added at the
691 my ( $c, $path, @args ) = @_;
692 my $base = $c->request->base->clone;
693 my $basepath = $base->path;
694 $basepath =~ s/\/$//;
696 my $namespace = $c->namespace;
698 # massage namespace, empty if absolute path
699 $namespace =~ s/^\///;
700 $namespace .= '/' if $namespace;
702 $namespace = '' if $path =~ /^\//;
705 # join args with '/', or a blank string
706 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
707 return URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ),
711 =item $c->welcome_message
713 Returns the Catalyst welcome HTML page.
717 sub welcome_message {
719 my $name = $c->config->{name};
720 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
721 my $prefix = Catalyst::Utils::appprefix( ref $c );
722 $c->response->content_type('text/html; charset=utf-8');
724 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
725 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
726 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
728 <meta http-equiv="Content-Language" content="en" />
729 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
730 <title>$name on Catalyst $VERSION</title>
731 <style type="text/css">
734 background-color: #eee;
743 background-color: #ccc;
744 border: 1px solid #aaa;
745 -moz-border-radius: 10px;
750 font-family: verdana, tahoma, sans-serif;
753 font-family: verdana, tahoma, sans-serif;
756 text-decoration: none;
758 border-bottom: 1px dotted #bbb;
760 :link:hover, :visited:hover {
773 background-color: #fff;
774 border: 1px solid #aaa;
775 -moz-border-radius: 10px;
801 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
806 <img src="$logo" alt="Catalyst Logo" />
808 <p>Welcome to the wonderful world of Catalyst.
809 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
810 framework will make web development something you had
811 never expected it to be: Fun, rewarding and quick.</p>
812 <h2>What to do now?</h2>
813 <p>That really depends on what <b>you</b> want to do.
814 We do, however, provide you with a few starting points.</p>
815 <p>If you want to jump right into web development with Catalyst
816 you might want to check out the documentation.</p>
817 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
818 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
819 <h2>What to do next?</h2>
820 <p>Next it's time to write an actual application. Use the
821 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
822 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
823 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
824 they can save you a lot of work.</p>
825 <pre><code>script/${prefix}_create.pl -help</code></pre>
826 <p>Also, be sure to check out the vast and growing
827 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
828 you are likely to find what you need there.
832 <p>Catalyst has a very active community. Here are the main places to
833 get in touch with us.</p>
836 <a href="http://dev.catalyst.perl.org">Wiki</a>
839 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
842 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
845 <h2>In conclusion</h2>
846 <p>The Catalyst team hopes you will enjoy using Catalyst as much
847 as we enjoyed making it. Please contact us if you have ideas
848 for improvement or other feedback.</p>
858 =head1 INTERNAL METHODS
860 These methods are not meant to be used by end users.
866 Returns a hash of components.
868 =item $c->context_class
870 Returns or sets the context class.
874 Returns a hashref containing coderefs and execution counts (needed for
875 deep recursion detection).
879 Returns the number of actions on the current internal execution stack.
883 Dispatches a request to actions.
887 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
889 =item $c->dispatcher_class
891 Returns or sets the dispatcher class.
895 Returns a list of 2-element array references (name, structure) pairs
896 that will be dumped on the error page in debug mode.
902 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
905 =item $c->engine_class
907 Returns or sets the engine class.
909 =item $c->execute( $class, $coderef )
911 Execute a coderef in given class and catch exceptions. Errors are available
917 my ( $c, $class, $code ) = @_;
918 $class = $c->components->{$class} || $class;
922 ( caller(0) )[0]->isa('Catalyst::Action')
929 $action = "/$action" unless $action =~ /\-\>/;
930 $c->counter->{"$code"}++;
932 if ( $c->counter->{"$code"} > $RECURSION ) {
933 my $error = qq/Deep recursion detected in "$action"/;
934 $c->log->error($error);
940 $action = "-> $action" if $callsub =~ /forward$/;
942 push( @{ $c->stack }, $code );
945 $start = [gettimeofday] if $c->debug;
946 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
947 $elapsed = tv_interval($start) if $c->debug;
950 unless ( ( $code->name =~ /^_.*/ )
951 && ( !$c->config->{show_internal_actions} ) )
953 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
956 pop( @{ $c->stack } );
958 if ( my $error = $@ ) {
960 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
962 unless ( ref $error ) {
964 $error = qq/Caught exception "$error"/;
975 Finalizes the request.
982 for my $error ( @{ $c->error } ) {
983 $c->log->error($error);
986 $c->finalize_uploads;
989 if ( $#{ $c->error } >= 0 ) {
993 $c->finalize_headers;
996 if ( $c->request->method eq 'HEAD' ) {
997 $c->response->body('');
1002 return $c->response->status;
1005 =item $c->finalize_body
1011 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1013 =item $c->finalize_cookies
1019 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1021 =item $c->finalize_error
1027 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1029 =item $c->finalize_headers
1035 sub finalize_headers {
1038 # Check if we already finalized headers
1039 return if $c->response->{_finalized_headers};
1042 if ( my $location = $c->response->redirect ) {
1043 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1044 $c->response->header( Location => $location );
1048 if ( $c->response->body && !$c->response->content_length ) {
1049 $c->response->content_length( bytes::length( $c->response->body ) );
1053 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1054 $c->response->headers->remove_header("Content-Length");
1055 $c->response->body('');
1058 $c->finalize_cookies;
1060 $c->engine->finalize_headers( $c, @_ );
1063 $c->response->{_finalized_headers} = 1;
1066 =item $c->finalize_output
1068 An alias for finalize_body.
1070 =item $c->finalize_read
1072 Finalizes the input after reading is complete.
1076 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1078 =item $c->finalize_uploads
1080 Finalizes uploads. Cleans up any temporary files.
1084 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1086 =item $c->get_action( $action, $namespace )
1088 Gets an action in a given namespace.
1092 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1094 =item $c->get_actions( $action, $namespace )
1096 Gets all actions of a given name in a namespace and all parent
1101 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1103 =item handle_request( $class, @arguments )
1105 Called to handle each HTTP request.
1109 sub handle_request {
1110 my ( $class, @arguments ) = @_;
1112 # Always expect worst case!
1118 my $c = $class->prepare(@arguments);
1119 $c->{stats} = \@stats;
1121 return $c->finalize;
1124 if ( $class->debug ) {
1125 my $start = [gettimeofday];
1126 $status = &$handler;
1127 my $elapsed = tv_interval $start;
1128 $elapsed = sprintf '%f', $elapsed;
1129 my $av = sprintf '%.3f',
1130 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1131 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1133 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
1135 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1137 else { $status = &$handler }
1141 if ( my $error = $@ ) {
1143 $class->log->error(qq/Caught exception in engine "$error"/);
1147 $class->log->_flush() if $class->log->can('_flush');
1151 =item $c->prepare( @arguments )
1153 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1159 my ( $class, @arguments ) = @_;
1161 $class->context_class( ref $class || $class ) unless $class->context_class;
1162 my $c = $class->context_class->new(
1166 request => $class->request_class->new(
1169 body_parameters => {},
1171 headers => HTTP::Headers->new,
1173 query_parameters => {},
1179 response => $class->response_class->new(
1183 headers => HTTP::Headers->new(),
1192 # For on-demand data
1193 $c->request->{_context} = $c;
1194 $c->response->{_context} = $c;
1195 weaken( $c->request->{_context} );
1196 weaken( $c->response->{_context} );
1199 my $secs = time - $START || 1;
1200 my $av = sprintf '%.3f', $COUNT / $secs;
1201 $c->log->debug('**********************************');
1202 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1203 $c->log->debug('**********************************');
1204 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1207 $c->prepare_request(@arguments);
1208 $c->prepare_connection;
1209 $c->prepare_query_parameters;
1210 $c->prepare_headers;
1211 $c->prepare_cookies;
1215 $c->prepare_body unless $c->config->{parse_on_demand};
1217 my $method = $c->req->method || '';
1218 my $path = $c->req->path || '';
1219 my $address = $c->req->address || '';
1221 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1229 =item $c->prepare_action
1235 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1237 =item $c->prepare_body
1239 Prepares message body.
1246 # Do we run for the first time?
1247 return if defined $c->request->{_body};
1249 # Initialize on-demand data
1250 $c->engine->prepare_body( $c, @_ );
1251 $c->prepare_parameters;
1252 $c->prepare_uploads;
1254 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1255 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1256 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1257 my $param = $c->req->body_parameters->{$key};
1258 my $value = defined($param) ? $param : '';
1260 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1262 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1266 =item $c->prepare_body_chunk( $chunk )
1268 Prepares a chunk of data before sending it to L<HTTP::Body>.
1272 sub prepare_body_chunk {
1274 $c->engine->prepare_body_chunk( $c, @_ );
1277 =item $c->prepare_body_parameters
1279 Prepares body parameters.
1283 sub prepare_body_parameters {
1285 $c->engine->prepare_body_parameters( $c, @_ );
1288 =item $c->prepare_connection
1290 Prepares connection.
1294 sub prepare_connection {
1296 $c->engine->prepare_connection( $c, @_ );
1299 =item $c->prepare_cookies
1305 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1307 =item $c->prepare_headers
1313 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1315 =item $c->prepare_parameters
1317 Prepares parameters.
1321 sub prepare_parameters {
1323 $c->prepare_body_parameters;
1324 $c->engine->prepare_parameters( $c, @_ );
1327 =item $c->prepare_path
1329 Prepares path and base.
1333 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1335 =item $c->prepare_query_parameters
1337 Prepares query parameters.
1341 sub prepare_query_parameters {
1344 $c->engine->prepare_query_parameters( $c, @_ );
1346 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1347 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1348 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1349 my $param = $c->req->query_parameters->{$key};
1350 my $value = defined($param) ? $param : '';
1352 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1354 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1358 =item $c->prepare_read
1360 Prepares the input for reading.
1364 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1366 =item $c->prepare_request
1368 Prepares the engine request.
1372 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1374 =item $c->prepare_uploads
1380 sub prepare_uploads {
1383 $c->engine->prepare_uploads( $c, @_ );
1385 if ( $c->debug && keys %{ $c->request->uploads } ) {
1386 my $t = Text::SimpleTable->new(
1392 for my $key ( sort keys %{ $c->request->uploads } ) {
1393 my $upload = $c->request->uploads->{$key};
1394 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1395 $t->row( $key, $u->filename, $u->type, $u->size );
1398 $c->log->debug( "File Uploads are:\n" . $t->draw );
1402 =item $c->prepare_write
1404 Prepares the output for writing.
1408 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1410 =item $c->request_class
1412 Returns or sets the request class.
1414 =item $c->response_class
1416 Returns or sets the response class.
1418 =item $c->read( [$maxlength] )
1420 Reads a chunk of data from the request body. This method is designed to
1421 be used in a while loop, reading C<$maxlength> bytes on every call.
1422 C<$maxlength> defaults to the size of the request if not specified.
1424 You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
1429 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1437 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1439 =item $c->set_action( $action, $code, $namespace, $attrs )
1441 Sets an action in a given namespace.
1445 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1447 =item $c->setup_actions($component)
1449 Sets up actions for a component.
1453 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1455 =item $c->setup_components
1461 sub setup_components {
1464 my $callback = sub {
1465 my ( $component, $context ) = @_;
1467 unless ( $component->isa('Catalyst::Component') ) {
1471 my $suffix = Catalyst::Utils::class2classsuffix($component);
1472 my $config = $class->config->{$suffix} || {};
1476 eval { $instance = $component->new( $context, $config ); };
1478 if ( my $error = $@ ) {
1482 Catalyst::Exception->throw( message =>
1483 qq/Couldn't instantiate component "$component", "$error"/ );
1486 Catalyst::Exception->throw( message =>
1487 qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1489 unless ref $instance;
1493 eval "package $class;\n" . q!Module::Pluggable::Fast->import(
1494 name => '_catalyst_components',
1496 "$class\::Controller", "$class\::C",
1497 "$class\::Model", "$class\::M",
1498 "$class\::View", "$class\::V"
1500 callback => $callback
1504 if ( my $error = $@ ) {
1508 Catalyst::Exception->throw(
1509 message => qq/Couldn't load components "$error"/ );
1512 for my $component ( $class->_catalyst_components($class) ) {
1513 $class->components->{ ref $component || $component } = $component;
1517 =item $c->setup_dispatcher
1523 sub setup_dispatcher {
1524 my ( $class, $dispatcher ) = @_;
1527 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1530 if ( $ENV{CATALYST_DISPATCHER} ) {
1531 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1534 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1536 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1539 unless ($dispatcher) {
1540 $dispatcher = $class->dispatcher_class;
1543 $dispatcher->require;
1546 Catalyst::Exception->throw(
1547 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1550 # dispatcher instance
1551 $class->dispatcher( $dispatcher->new );
1554 =item $c->setup_engine
1561 my ( $class, $engine ) = @_;
1564 $engine = 'Catalyst::Engine::' . $engine;
1567 if ( $ENV{CATALYST_ENGINE} ) {
1568 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1571 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1572 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1575 if ( !$engine && $ENV{MOD_PERL} ) {
1577 # create the apache method
1580 *{"$class\::apache"} = sub { shift->engine->apache };
1583 my ( $software, $version ) =
1584 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1587 $version =~ s/(\.[^.]+)\./$1/g;
1589 if ( $software eq 'mod_perl' ) {
1591 if ( $version >= 1.99922 ) {
1592 $engine = 'Catalyst::Engine::Apache2::MP20';
1595 elsif ( $version >= 1.9901 ) {
1596 $engine = 'Catalyst::Engine::Apache2::MP19';
1599 elsif ( $version >= 1.24 ) {
1600 $engine = 'Catalyst::Engine::Apache::MP13';
1604 Catalyst::Exception->throw( message =>
1605 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1608 # install the correct mod_perl handler
1609 if ( $version >= 1.9901 ) {
1610 *handler = sub : method {
1611 shift->handle_request(@_);
1615 *handler = sub ($$) { shift->handle_request(@_) };
1620 elsif ( $software eq 'Zeus-Perl' ) {
1621 $engine = 'Catalyst::Engine::Zeus';
1625 Catalyst::Exception->throw(
1626 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1631 $engine = $class->engine_class;
1637 Catalyst::Exception->throw( message =>
1638 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1642 # check for old engines that are no longer compatible
1644 if ( $engine->isa('Catalyst::Engine::Apache')
1645 && !Catalyst::Engine::Apache->VERSION )
1650 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1651 && Catalyst::Engine::Server->VERSION le '0.02' )
1656 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1657 && $engine->VERSION eq '0.01' )
1662 elsif ($engine->isa('Catalyst::Engine::Zeus')
1663 && $engine->VERSION eq '0.01' )
1669 Catalyst::Exception->throw( message =>
1670 qq/Engine "$engine" is not supported by this version of Catalyst/
1675 $class->engine( $engine->new );
1678 =item $c->setup_home
1680 Sets up the home directory.
1685 my ( $class, $home ) = @_;
1687 if ( $ENV{CATALYST_HOME} ) {
1688 $home = $ENV{CATALYST_HOME};
1691 if ( $ENV{ uc($class) . '_HOME' } ) {
1692 $home = $ENV{ uc($class) . '_HOME' };
1696 $home = Catalyst::Utils::home($class);
1700 $class->config->{home} ||= $home;
1701 $class->config->{root} ||= dir($home)->subdir('root');
1712 my ( $class, $debug ) = @_;
1714 unless ( $class->log ) {
1715 $class->log( Catalyst::Log->new );
1718 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1721 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1722 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1727 *{"$class\::debug"} = sub { 1 };
1728 $class->log->debug('Debug messages enabled');
1732 =item $c->setup_plugins
1739 my ( $class, $plugins ) = @_;
1742 for my $plugin ( reverse @$plugins ) {
1744 $plugin = "Catalyst::Plugin::$plugin";
1749 Catalyst::Exception->throw(
1750 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1755 unshift @{"$class\::ISA"}, $plugin;
1764 =item $c->write( $data )
1766 Writes $data to the output stream. When using this method directly, you
1767 will need to manually set the C<Content-Length> header to the length of
1768 your output data, if known.
1775 # Finalize headers if someone manually writes output
1776 $c->finalize_headers;
1778 return $c->engine->write( $c, @_ );
1783 Returns the Catalyst version number. Mostly useful for "powered by"
1784 messages in template systems.
1788 sub version { return $Catalyst::VERSION }
1792 =head1 INTERNAL ACTIONS
1794 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
1795 C<_ACTION>, and C<_END>. These are by default not shown in the private
1796 action table, but you can make them visible with a config parameter.
1798 MyApp->config->{show_internal_actions} = 1;
1800 =head1 CASE SENSITIVITY
1802 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
1803 mapped to C</foo/bar>. You can activate case sensitivity with a config
1806 MyApp->config->{case_sensitive} = 1;
1808 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
1810 =head1 ON-DEMAND PARSER
1812 The request body is usually parsed at the beginning of a request,
1813 but if you want to handle input yourself or speed things up a bit,
1814 you can enable on-demand parsing with a config parameter.
1816 MyApp->config->{parse_on_demand} = 1;
1818 =head1 PROXY SUPPORT
1820 Many production servers operate using the common double-server approach,
1821 with a lightweight frontend web server passing requests to a larger
1822 backend server. An application running on the backend server must deal
1823 with two problems: the remote user always appears to be C<127.0.0.1> and
1824 the server's hostname will appear to be C<localhost> regardless of the
1825 virtual host that the user connected through.
1827 Catalyst will automatically detect this situation when you are running
1828 the frontend and backend servers on the same machine. The following
1829 changes are made to the request.
1831 $c->req->address is set to the user's real IP address, as read from
1832 the HTTP X-Forwarded-For header.
1834 The host value for $c->req->base and $c->req->uri is set to the real
1835 host, as read from the HTTP X-Forwarded-Host header.
1837 Obviously, your web server must support these headers for this to work.
1839 In a more complex server farm environment where you may have your
1840 frontend proxy server(s) on different machines, you will need to set a
1841 configuration option to tell Catalyst to read the proxied data from the
1844 MyApp->config->{using_frontend_proxy} = 1;
1846 If you do not wish to use the proxy support at all, you may set:
1848 MyApp->config->{ignore_frontend_proxy} = 1;
1850 =head1 THREAD SAFETY
1852 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1853 and the standalone forking HTTP server on Windows. We believe the Catalyst
1854 core to be thread-safe.
1856 If you plan to operate in a threaded environment, remember that all other
1857 modules you are using must also be thread-safe. Some modules, most notably
1858 L<DBD::SQLite>, are not thread-safe.
1864 Join #catalyst on irc.perl.org.
1868 http://lists.rawmode.org/mailman/listinfo/catalyst
1869 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1873 http://catalyst.perl.org
1877 http://dev.catalyst.perl.org
1883 =item L<Catalyst::Manual> - The Catalyst Manual
1885 =item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1887 =item L<Catalyst::Engine> - Core engine
1889 =item L<Catalyst::Log> - Log class.
1891 =item L<Catalyst::Request> - Request object
1893 =item L<Catalyst::Response> - Response object
1895 =item L<Catalyst::Test> - The test suite.
1965 Sebastian Riedel, C<sri@oook.de>
1969 This library is free software, you can redistribute it and/or modify it under
1970 the same terms as Perl itself.