4 use base 'Catalyst::Component';
6 use UNIVERSAL::require;
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
13 use Catalyst::Controller;
16 use Text::SimpleTable;
18 use Time::HiRes qw/gettimeofday tv_interval/;
20 use Scalar::Util qw/weaken/;
21 use Tree::Simple qw/use_weak_refs/;
22 use Tree::Simple::Visitor::FindByUID;
25 __PACKAGE__->mk_accessors(
26 qw/counter request response state action stack namespace/
29 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
31 sub depth { scalar @{ shift->stack || [] }; }
38 # For backwards compatibility
39 *finalize_output = \&finalize_body;
44 our $RECURSION = 1000;
45 our $DETACH = "catalyst_detach\n";
47 require Module::Pluggable::Fast;
49 # Helper script generation
50 our $CATALYST_SCRIPT_GEN = 26;
52 __PACKAGE__->mk_classdata($_)
53 for qw/components arguments dispatcher engine log dispatcher_class
54 engine_class context_class request_class response_class setup_finished/;
56 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
57 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
58 __PACKAGE__->request_class('Catalyst::Request');
59 __PACKAGE__->response_class('Catalyst::Response');
61 our $VERSION = '5.64';
64 my ( $class, @arguments ) = @_;
66 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
68 return unless $class eq 'Catalyst';
70 my $caller = caller(0);
72 unless ( $caller->isa('Catalyst') ) {
74 push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
77 $caller->arguments( [@arguments] );
83 Catalyst - The Elegant MVC Web Application Framework
87 # use the helper to start a new application
90 # add models, views, controllers
91 script/myapp_create.pl model Database DBIC dbi:SQLite:/path/to/db
92 script/myapp_create.pl view TT TT
93 script/myapp_create.pl controller Search
95 # built in testserver -- use -r to restart automatically on changes
96 script/myapp_server.pl
98 # command line testing interface
99 script/myapp_test.pl /yada
102 use Catalyst qw/-Debug/; # include plugins here as well
104 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
105 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
106 $c->stash->{template} = 'foo.tt'; # set the template
107 # lookup something from db -- stash vars are passed to TT
109 MyApp::Model::Database::Foo->search( { country => $args[0] } );
110 if ( $c->req->params->{bar} ) { # access GET or POST parameters
111 $c->forward( 'bar' ); # process another action
112 # do something else after forward returns
116 # The foo.tt TT template can use the stash data from the database
117 [% WHILE (item = data.next) %]
121 # called for /bar/of/soap, /bar/of/soap/10, etc.
122 sub bar : Path('/bar/of/soap') { ... }
124 # called for all actions, from the top-most controller downwards
126 my ( $self, $c ) = @_;
128 $c->res->redirect( '/login' ); # require login
129 return 0; # abort request and go immediately to end()
131 return 1; # success; carry on to next action
134 # called after all actions are finished
136 my ( $self, $c ) = @_;
137 if ( scalar @{ $c->error } ) { ... } # handle errors
138 return if $c->res->body; # already have a response
139 $c->forward( 'MyApp::View::TT' ); # render template
142 ### in MyApp/Controller/Foo.pm
143 # called for /foo/bar
144 sub bar : Local { ... }
146 # called for /blargle
147 sub blargle : Global { ... }
149 # an index action matches /foo, but not /foo/1, etc.
150 sub index : Private { ... }
152 ### in MyApp/Controller/Foo/Bar.pm
153 # called for /foo/bar/baz
154 sub baz : Local { ... }
156 # first MyApp auto is called, then Foo auto, then this
157 sub auto : Private { ... }
159 # powerful regular expression paths are also possible
160 sub details : Regex('^product/(\w+)/details$') {
161 my ( $self, $c ) = @_;
162 # extract the (\w+) from the URI
163 my $product = $c->req->snippets->[0];
166 See L<Catalyst::Manual::Intro> for additional information.
170 The key concept of Catalyst is DRY (Don't Repeat Yourself).
172 See L<Catalyst::Manual> for more documentation.
174 Catalyst plugins can be loaded by naming them as arguments to the "use
175 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
176 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
179 use Catalyst qw/My::Module/;
181 Special flags like C<-Debug> and C<-Engine> can also be specified as
182 arguments when Catalyst is loaded:
184 use Catalyst qw/-Debug My::Module/;
186 The position of plugins and flags in the chain is important, because
187 they are loaded in exactly the order in which they appear.
189 The following flags are supported:
193 Enables debug output.
197 Forces Catalyst to use a specific engine. Omit the
198 C<Catalyst::Engine::> prefix of the engine name, i.e.:
200 use Catalyst qw/-Engine=CGI/;
204 Forces Catalyst to use a specific home directory, e.g.:
206 use Catalyst qw[-Home=/usr/sri];
214 =head2 Information about the current request
218 Returns a L<Catalyst::Action> object for the current action, which
219 stringifies to the action name. See L<Catalyst::Action>.
223 Returns the namespace of the current action, i.e., the uri prefix
224 corresponding to the controller of the current action. For example:
226 # in Controller::Foo::Bar
227 $c->namespace; # returns 'foo/bar';
233 Returns the current L<Catalyst::Request> object. See
234 L<Catalyst::Request>.
236 =head2 Processing and response to the current request
238 =head2 $c->forward( $action [, \@arguments ] )
240 =head2 $c->forward( $class, $method, [, \@arguments ] )
242 Forwards processing to a private action. If you give a class name but no
243 method, C<process()> is called. You may also optionally pass arguments
244 in an arrayref. The action will receive the arguments in C<@_> and
245 C<$c-E<gt>req-E<gt>args>. Upon returning from the function,
246 C<$c-E<gt>req-E<gt>args> will be restored to the previous values.
248 Any data C<return>ed from the action forwarded to, will be returned by the
251 my $foodata = $c->forward('/foo');
252 $c->forward('index');
253 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
254 $c->forward('MyApp::View::TT');
258 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
260 =head2 $c->detach( $action [, \@arguments ] )
262 =head2 $c->detach( $class, $method, [, \@arguments ] )
264 The same as C<forward>, but doesn't return.
268 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
272 =head2 $c->error($error, ...)
274 =head2 $c->error($arrayref)
276 Returns an arrayref containing error messages. If Catalyst encounters an
277 error while processing a request, it stores the error in $c->error. This
278 method should not be used to store non-fatal error messages.
280 my @error = @{ $c->error };
284 $c->error('Something bad happened');
286 Clear errors. You probably don't want to clear the errors unless you are
287 implementing a custom error screen.
296 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
297 push @{ $c->{error} }, @$error;
299 elsif ( defined $_[0] ) { $c->{error} = undef }
300 return $c->{error} || [];
307 Returns the current L<Catalyst::Response> object.
311 Returns a hashref to the stash, which may be used to store data and pass
312 it between components during a request. You can also set hash keys by
313 passing arguments. The stash is automatically sent to the view. The
314 stash is cleared at the end of a request; it cannot be used for
317 $c->stash->{foo} = $bar;
318 $c->stash( { moose => 'majestic', qux => 0 } );
319 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
321 # stash is automatically passed to the view for use in a template
322 $c->forward( 'MyApp::V::TT' );
329 my $stash = @_ > 1 ? {@_} : $_[0];
330 while ( my ( $key, $val ) = each %$stash ) {
331 $c->{stash}->{$key} = $val;
339 Contains the return value of the last executed action.
341 =head2 Component Accessors
343 =head2 $c->comp($name)
345 =head2 $c->component($name)
347 Gets a component object by name. This method is no longer recommended,
348 unless you want to get a specific component by full
349 class. C<$c-E<gt>controller>, C<$c-E<gt>model>, and C<$c-E<gt>view>
350 should be used instead.
361 my $appclass = ref $c || $c;
364 $name, "${appclass}::${name}",
365 map { "${appclass}::${_}::${name}" }
366 qw/Model M Controller C View V/
369 foreach my $try (@names) {
371 if ( exists $c->components->{$try} ) {
373 my $comp = $c->components->{$try};
374 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
375 return $comp->ACCEPT_CONTEXT($c);
377 else { return $comp }
381 foreach my $component ( keys %{ $c->components } ) {
383 $comp = $c->components->{$component} if $component =~ /$name/i;
385 if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
386 return $comp->ACCEPT_CONTEXT($c);
388 else { return $comp }
394 return sort keys %{ $c->components };
397 =head2 $c->controller($name)
399 Gets a L<Catalyst::Controller> instance by name.
401 $c->controller('Foo')->do_stuff;
406 my ( $c, $name ) = @_;
407 my $controller = $c->comp("Controller::$name");
408 return $controller if defined $controller;
409 return $c->comp("C::$name");
412 =head2 $c->model($name)
414 Gets a L<Catalyst::Model> instance by name.
416 $c->model('Foo')->do_stuff;
421 my ( $c, $name ) = @_;
422 my $model = $c->comp("Model::$name");
423 return $model if defined $model;
424 return $c->comp("M::$name");
427 =head2 $c->view($name)
429 Gets a L<Catalyst::View> instance by name.
431 $c->view('Foo')->do_stuff;
436 my ( $c, $name ) = @_;
437 my $view = $c->comp("View::$name");
438 return $view if defined $view;
439 return $c->comp("V::$name");
442 =head2 Class data and helper classes
446 Returns or takes a hashref containing the application's configuration.
448 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
455 $c->log->warn("Setting config after setup has been run is not a good idea.")
456 if ( @_ and $c->setup_finished );
458 $c->NEXT::config(@_);
463 Overload to enable debug messages (same as -Debug option).
469 =head2 $c->dispatcher
471 Returns the dispatcher instance. Stringifies to class name. See
472 L<Catalyst::Dispatcher>.
476 Returns the engine instance. Stringifies to the class name. See
481 Returns the logging object instance. Unless it is already set, Catalyst sets
482 this up with a L<Catalyst::Log> object. To use your own log class, set the
483 logger with the C<< __PACKAGE__->log >> method prior to calling
484 C<< __PACKAGE__->setup >>.
486 __PACKAGE__->log( MyLogger->new );
491 $c->log->info( 'Now logging with my own logger!' );
493 Your log class should implement the methods described in the
494 L<Catalyst::Log> man page.
498 =head2 Utility methods
500 =head2 $c->path_to(@path)
502 Merges C<@path> with C<$c-E<gt>config-E<gt>{home}> and returns a
503 L<Path::Class> object.
507 $c->path_to( 'db', 'sqlite.db' );
512 my ( $c, @path ) = @_;
513 my $path = dir( $c->config->{home}, @path );
514 if ( -d $path ) { return $path }
515 else { return file( $c->config->{home}, @path ) }
518 =head2 $c->plugin( $name, $class, @args )
520 Helper method for plugins. It creates a classdata accessor/mutator and
521 loads and instantiates the given class.
523 MyApp->plugin( 'prototype', 'HTML::Prototype' );
525 $c->prototype->define_javascript_functions;
530 my ( $class, $name, $plugin, @args ) = @_;
533 if ( my $error = $UNIVERSAL::require::ERROR ) {
534 Catalyst::Exception->throw(
535 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
538 eval { $plugin->import };
539 $class->mk_classdata($name);
541 eval { $obj = $plugin->new(@args) };
544 Catalyst::Exception->throw( message =>
545 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
549 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
555 Initializes the dispatcher and engine, loads any plugins, and loads the
556 model, view, and controller components. You may also specify an array
557 of plugins to load here, if you choose to not load them in the C<use
561 MyApp->setup( qw/-Debug/ );
566 my ( $class, @arguments ) = @_;
568 unless ( $class->isa('Catalyst') ) {
570 Catalyst::Exception->throw(
571 message => qq/'$class' does not inherit from Catalyst/ );
574 if ( $class->arguments ) {
575 @arguments = ( @arguments, @{ $class->arguments } );
581 foreach (@arguments) {
585 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
587 elsif (/^-(\w+)=?(.*)$/) {
588 $flags->{ lc $1 } = $2;
591 push @{ $flags->{plugins} }, $_;
595 $class->setup_home( delete $flags->{home} );
597 $class->setup_log( delete $flags->{log} );
598 $class->setup_plugins( delete $flags->{plugins} );
599 $class->setup_dispatcher( delete $flags->{dispatcher} );
600 $class->setup_engine( delete $flags->{engine} );
602 for my $flag ( sort keys %{$flags} ) {
604 if ( my $code = $class->can( 'setup_' . $flag ) ) {
605 &$code( $class, delete $flags->{$flag} );
608 $class->log->warn(qq/Unknown flag "$flag"/);
613 <<"EOF") if ( $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
614 You are running an old script!
616 Please update by running (this will overwrite existing files):
617 catalyst.pl -force -scripts $class
619 or (this will not overwrite existing files):
620 catalyst.pl -scripts $class
623 if ( $class->debug ) {
630 map { $_ . ' ' . ( $_->VERSION || '' ) }
631 grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
635 my $t = Text::SimpleTable->new(76);
636 $t->row($_) for @plugins;
637 $class->log->debug( "Loaded plugins:\n" . $t->draw );
640 my $dispatcher = $class->dispatcher;
641 my $engine = $class->engine;
642 my $home = $class->config->{home};
644 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
645 $class->log->debug(qq/Loaded engine "$engine"/);
649 ? $class->log->debug(qq/Found home "$home"/)
650 : $class->log->debug(qq/Home "$home" doesn't exist/)
651 : $class->log->debug(q/Couldn't find home/);
656 no warnings qw/redefine/;
657 local *setup = sub { };
661 # Initialize our data structure
662 $class->components( {} );
664 $class->setup_components;
666 if ( $class->debug ) {
667 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
668 for my $comp ( sort keys %{ $class->components } ) {
669 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
670 $t->row( $comp, $type );
672 $class->log->debug( "Loaded components:\n" . $t->draw )
673 if ( keys %{ $class->components } );
676 # Add our self to components, since we are also a component
677 $class->components->{$class} = $class;
679 $class->setup_actions;
681 if ( $class->debug ) {
682 my $name = $class->config->{name} || 'Application';
683 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
685 $class->log->_flush() if $class->log->can('_flush');
687 $class->setup_finished(1);
690 =head2 $c->uri_for( $path, [ @args ] )
692 Merges path with C<$c-E<gt>request-E<gt>base> for absolute uri's and
693 with C<$c-E<gt>namespace> for relative uri's, then returns a
694 normalized L<URI> object. If any args are passed, they are added at the
700 my ( $c, $path, @args ) = @_;
701 my $base = $c->request->base->clone;
702 my $basepath = $base->path;
703 $basepath =~ s/\/$//;
705 my $namespace = $c->namespace;
707 # massage namespace, empty if absolute path
708 $namespace =~ s/^\///;
709 $namespace .= '/' if $namespace;
711 $namespace = '' if $path =~ /^\//;
714 # join args with '/', or a blank string
715 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
716 $args =~ s/^\/// unless $path;
718 URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base )
723 =head2 $c->welcome_message
725 Returns the Catalyst welcome HTML page.
729 sub welcome_message {
731 my $name = $c->config->{name};
732 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
733 my $prefix = Catalyst::Utils::appprefix( ref $c );
734 $c->response->content_type('text/html; charset=utf-8');
736 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
737 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
738 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
740 <meta http-equiv="Content-Language" content="en" />
741 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
742 <title>$name on Catalyst $VERSION</title>
743 <style type="text/css">
746 background-color: #eee;
755 background-color: #ccc;
756 border: 1px solid #aaa;
757 -moz-border-radius: 10px;
762 font-family: verdana, tahoma, sans-serif;
765 font-family: verdana, tahoma, sans-serif;
768 text-decoration: none;
770 border-bottom: 1px dotted #bbb;
772 :link:hover, :visited:hover {
785 background-color: #fff;
786 border: 1px solid #aaa;
787 -moz-border-radius: 10px;
813 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
818 <img src="$logo" alt="Catalyst Logo" />
820 <p>Welcome to the wonderful world of Catalyst.
821 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
822 framework will make web development something you had
823 never expected it to be: Fun, rewarding, and quick.</p>
824 <h2>What to do now?</h2>
825 <p>That really depends on what <b>you</b> want to do.
826 We do, however, provide you with a few starting points.</p>
827 <p>If you want to jump right into web development with Catalyst
828 you might want to check out the documentation.</p>
829 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
830 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
831 perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
832 <h2>What to do next?</h2>
833 <p>Next it's time to write an actual application. Use the
834 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
835 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
836 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
837 they can save you a lot of work.</p>
838 <pre><code>script/${prefix}_create.pl -help</code></pre>
839 <p>Also, be sure to check out the vast and growing
840 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
841 you are likely to find what you need there.
845 <p>Catalyst has a very active community. Here are the main places to
846 get in touch with us.</p>
849 <a href="http://dev.catalyst.perl.org">Wiki</a>
852 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
855 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
858 <h2>In conclusion</h2>
859 <p>The Catalyst team hopes you will enjoy using Catalyst as much
860 as we enjoyed making it. Please contact us if you have ideas
861 for improvement or other feedback.</p>
869 =head1 INTERNAL METHODS
871 These methods are not meant to be used by end users.
873 =head2 $c->components
875 Returns a hash of components.
877 =head2 $c->context_class
879 Returns or sets the context class.
883 Returns a hashref containing coderefs and execution counts (needed for
884 deep recursion detection).
888 Returns the number of actions on the current internal execution stack.
892 Dispatches a request to actions.
896 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
898 =head2 $c->dispatcher_class
900 Returns or sets the dispatcher class.
902 =head2 $c->dump_these
904 Returns a list of 2-element array references (name, structure) pairs
905 that will be dumped on the error page in debug mode.
911 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
914 =head2 $c->engine_class
916 Returns or sets the engine class.
918 =head2 $c->execute( $class, $coderef )
920 Execute a coderef in given class and catch exceptions. Errors are available
926 my ( $c, $class, $code ) = @_;
927 $class = $c->component($class) || $class;
931 my $action = "$code";
932 $action = "/$action" unless $action =~ /\-\>/;
933 $c->counter->{"$code"}++;
935 if ( $c->counter->{"$code"} > $RECURSION ) {
936 my $error = qq/Deep recursion detected in "$action"/;
937 $c->log->error($error);
943 # determine if the call was the result of a forward
944 # this is done by walking up the call stack and looking for a calling
945 # sub of Catalyst::forward before the eval
947 for my $index ( 1 .. 10 ) {
949 if ( ( caller($index) )[0] eq 'Catalyst'
950 && ( caller($index) )[3] eq '(eval)' );
952 if ( ( caller($index) )[3] =~ /forward$/ ) {
953 $callsub = ( caller($index) )[3];
954 $action = "-> $action";
959 my $node = Tree::Simple->new(
962 elapsed => undef, # to be filled in later
965 $node->setUID( "$code" . $c->counter->{"$code"} );
967 unless ( ( $code->name =~ /^_.*/ )
968 && ( !$c->config->{show_internal_actions} ) )
971 # is this a root-level call or a forwarded call?
972 if ( $callsub =~ /forward$/ ) {
974 # forward, locate the caller
975 if ( my $parent = $c->stack->[-1] ) {
976 my $visitor = Tree::Simple::Visitor::FindByUID->new;
977 $visitor->searchForUID(
978 "$parent" . $c->counter->{"$parent"} );
979 $c->{stats}->accept($visitor);
980 if ( my $result = $visitor->getResult ) {
981 $result->addChild($node);
986 # forward with no caller may come from a plugin
987 $c->{stats}->addChild($node);
993 $c->{stats}->addChild($node);
998 push( @{ $c->stack }, $code );
1001 $start = [gettimeofday] if $c->debug;
1002 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
1003 $elapsed = tv_interval($start) if $c->debug;
1006 unless ( ( $code->name =~ /^_.*/ )
1007 && ( !$c->config->{show_internal_actions} ) )
1010 # FindByUID uses an internal die, so we save the existing error
1013 # locate the node in the tree and update the elapsed time
1014 my $visitor = Tree::Simple::Visitor::FindByUID->new;
1015 $visitor->searchForUID( "$code" . $c->counter->{"$code"} );
1016 $c->{stats}->accept($visitor);
1017 if ( my $result = $visitor->getResult ) {
1018 my $value = $result->getNodeValue;
1019 $value->{elapsed} = sprintf( '%fs', $elapsed );
1020 $result->setNodeValue($value);
1024 $@ = $error || undef;
1027 my $last = ${ $c->stack }[-1];
1028 pop( @{ $c->stack } );
1030 if ( my $error = $@ ) {
1031 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
1033 unless ( ref $error ) {
1035 my $class = $last->class;
1036 my $name = $last->name;
1037 $error = qq/Caught exception in $class->$name "$error"/;
1048 Finalizes the request.
1055 for my $error ( @{ $c->error } ) {
1056 $c->log->error($error);
1059 $c->finalize_uploads;
1062 if ( $#{ $c->error } >= 0 ) {
1066 $c->finalize_headers;
1069 if ( $c->request->method eq 'HEAD' ) {
1070 $c->response->body('');
1075 return $c->response->status;
1078 =head2 $c->finalize_body
1084 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1086 =head2 $c->finalize_cookies
1092 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1094 =head2 $c->finalize_error
1100 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1102 =head2 $c->finalize_headers
1108 sub finalize_headers {
1111 # Check if we already finalized headers
1112 return if $c->response->{_finalized_headers};
1115 if ( my $location = $c->response->redirect ) {
1116 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1117 $c->response->header( Location => $location );
1121 if ( $c->response->body && !$c->response->content_length ) {
1123 # get the length from a filehandle
1124 if ( ref $c->response->body && $c->response->body->can('read') ) {
1125 if ( my $stat = stat $c->response->body ) {
1126 $c->response->content_length( $stat->size );
1129 $c->log->warn('Serving filehandle without a content-length');
1133 $c->response->content_length( bytes::length( $c->response->body ) );
1138 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1139 $c->response->headers->remove_header("Content-Length");
1140 $c->response->body('');
1143 $c->finalize_cookies;
1145 $c->engine->finalize_headers( $c, @_ );
1148 $c->response->{_finalized_headers} = 1;
1151 =head2 $c->finalize_output
1153 An alias for finalize_body.
1155 =head2 $c->finalize_read
1157 Finalizes the input after reading is complete.
1161 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1163 =head2 $c->finalize_uploads
1165 Finalizes uploads. Cleans up any temporary files.
1169 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1171 =head2 $c->get_action( $action, $namespace )
1173 Gets an action in a given namespace.
1177 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1179 =head2 $c->get_actions( $action, $namespace )
1181 Gets all actions of a given name in a namespace and all parent
1186 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1188 =head2 handle_request( $class, @arguments )
1190 Called to handle each HTTP request.
1194 sub handle_request {
1195 my ( $class, @arguments ) = @_;
1197 # Always expect worst case!
1200 my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
1203 my $c = $class->prepare(@arguments);
1204 $c->{stats} = $stats;
1206 return $c->finalize;
1209 if ( $class->debug ) {
1210 my $start = [gettimeofday];
1211 $status = &$handler;
1212 my $elapsed = tv_interval $start;
1213 $elapsed = sprintf '%f', $elapsed;
1214 my $av = sprintf '%.3f',
1215 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1216 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
1221 my $stat = $action->getNodeValue;
1222 $t->row( ( q{ } x $action->getDepth ) . $stat->{action},
1223 $stat->{elapsed} || '??' );
1228 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1230 else { $status = &$handler }
1234 if ( my $error = $@ ) {
1236 $class->log->error(qq/Caught exception in engine "$error"/);
1240 $class->log->_flush() if $class->log->can('_flush');
1244 =head2 $c->prepare( @arguments )
1246 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1252 my ( $class, @arguments ) = @_;
1254 $class->context_class( ref $class || $class ) unless $class->context_class;
1255 my $c = $class->context_class->new(
1259 request => $class->request_class->new(
1262 body_parameters => {},
1264 headers => HTTP::Headers->new,
1266 query_parameters => {},
1272 response => $class->response_class->new(
1276 headers => HTTP::Headers->new(),
1285 # For on-demand data
1286 $c->request->{_context} = $c;
1287 $c->response->{_context} = $c;
1288 weaken( $c->request->{_context} );
1289 weaken( $c->response->{_context} );
1292 my $secs = time - $START || 1;
1293 my $av = sprintf '%.3f', $COUNT / $secs;
1294 $c->log->debug('**********************************');
1295 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1296 $c->log->debug('**********************************');
1297 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1300 $c->prepare_request(@arguments);
1301 $c->prepare_connection;
1302 $c->prepare_query_parameters;
1303 $c->prepare_headers;
1304 $c->prepare_cookies;
1308 $c->prepare_body unless $c->config->{parse_on_demand};
1310 my $method = $c->req->method || '';
1311 my $path = $c->req->path || '';
1312 my $address = $c->req->address || '';
1314 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1322 =head2 $c->prepare_action
1328 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1330 =head2 $c->prepare_body
1332 Prepares message body.
1339 # Do we run for the first time?
1340 return if defined $c->request->{_body};
1342 # Initialize on-demand data
1343 $c->engine->prepare_body( $c, @_ );
1344 $c->prepare_parameters;
1345 $c->prepare_uploads;
1347 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1348 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1349 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1350 my $param = $c->req->body_parameters->{$key};
1351 my $value = defined($param) ? $param : '';
1353 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1355 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1359 =head2 $c->prepare_body_chunk( $chunk )
1361 Prepares a chunk of data before sending it to L<HTTP::Body>.
1365 sub prepare_body_chunk {
1367 $c->engine->prepare_body_chunk( $c, @_ );
1370 =head2 $c->prepare_body_parameters
1372 Prepares body parameters.
1376 sub prepare_body_parameters {
1378 $c->engine->prepare_body_parameters( $c, @_ );
1381 =head2 $c->prepare_connection
1383 Prepares connection.
1387 sub prepare_connection {
1389 $c->engine->prepare_connection( $c, @_ );
1392 =head2 $c->prepare_cookies
1398 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1400 =head2 $c->prepare_headers
1406 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1408 =head2 $c->prepare_parameters
1410 Prepares parameters.
1414 sub prepare_parameters {
1416 $c->prepare_body_parameters;
1417 $c->engine->prepare_parameters( $c, @_ );
1420 =head2 $c->prepare_path
1422 Prepares path and base.
1426 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1428 =head2 $c->prepare_query_parameters
1430 Prepares query parameters.
1434 sub prepare_query_parameters {
1437 $c->engine->prepare_query_parameters( $c, @_ );
1439 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1440 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
1441 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1442 my $param = $c->req->query_parameters->{$key};
1443 my $value = defined($param) ? $param : '';
1445 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1447 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1451 =head2 $c->prepare_read
1453 Prepares the input for reading.
1457 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1459 =head2 $c->prepare_request
1461 Prepares the engine request.
1465 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1467 =head2 $c->prepare_uploads
1473 sub prepare_uploads {
1476 $c->engine->prepare_uploads( $c, @_ );
1478 if ( $c->debug && keys %{ $c->request->uploads } ) {
1479 my $t = Text::SimpleTable->new(
1485 for my $key ( sort keys %{ $c->request->uploads } ) {
1486 my $upload = $c->request->uploads->{$key};
1487 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1488 $t->row( $key, $u->filename, $u->type, $u->size );
1491 $c->log->debug( "File Uploads are:\n" . $t->draw );
1495 =head2 $c->prepare_write
1497 Prepares the output for writing.
1501 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1503 =head2 $c->request_class
1505 Returns or sets the request class.
1507 =head2 $c->response_class
1509 Returns or sets the response class.
1511 =head2 $c->read( [$maxlength] )
1513 Reads a chunk of data from the request body. This method is designed to
1514 be used in a while loop, reading C<$maxlength> bytes on every call.
1515 C<$maxlength> defaults to the size of the request if not specified.
1517 You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
1522 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1530 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1532 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1534 Sets an action in a given namespace.
1538 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1540 =head2 $c->setup_actions($component)
1542 Sets up actions for a component.
1546 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1548 =head2 $c->setup_components
1554 sub setup_components {
1557 my $callback = sub {
1558 my ( $component, $context ) = @_;
1560 unless ( $component->can('COMPONENT') ) {
1564 my $suffix = Catalyst::Utils::class2classsuffix($component);
1565 my $config = $class->config->{$suffix} || {};
1569 eval { $instance = $component->COMPONENT( $context, $config ); };
1571 if ( my $error = $@ ) {
1575 Catalyst::Exception->throw( message =>
1576 qq/Couldn't instantiate component "$component", "$error"/ );
1579 Catalyst::Exception->throw( message =>
1580 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return a object"/
1582 unless ref $instance;
1586 eval "package $class;\n" . q!Module::Pluggable::Fast->import(
1587 name => '_catalyst_components',
1589 "$class\::Controller", "$class\::C",
1590 "$class\::Model", "$class\::M",
1591 "$class\::View", "$class\::V"
1593 callback => $callback
1597 if ( my $error = $@ ) {
1601 Catalyst::Exception->throw(
1602 message => qq/Couldn't load components "$error"/ );
1605 for my $component ( $class->_catalyst_components($class) ) {
1606 $class->components->{ ref $component || $component } = $component;
1610 =head2 $c->setup_dispatcher
1616 sub setup_dispatcher {
1617 my ( $class, $dispatcher ) = @_;
1620 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1623 if ( $ENV{CATALYST_DISPATCHER} ) {
1624 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1627 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1629 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1632 unless ($dispatcher) {
1633 $dispatcher = $class->dispatcher_class;
1636 $dispatcher->require;
1639 Catalyst::Exception->throw(
1640 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1643 # dispatcher instance
1644 $class->dispatcher( $dispatcher->new );
1647 =head2 $c->setup_engine
1654 my ( $class, $engine ) = @_;
1657 $engine = 'Catalyst::Engine::' . $engine;
1660 if ( $ENV{CATALYST_ENGINE} ) {
1661 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1664 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1665 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1668 if ( $ENV{MOD_PERL} ) {
1670 # create the apache method
1673 *{"$class\::apache"} = sub { shift->engine->apache };
1676 my ( $software, $version ) =
1677 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1680 $version =~ s/(\.[^.]+)\./$1/g;
1682 if ( $software eq 'mod_perl' ) {
1686 if ( $version >= 1.99922 ) {
1687 $engine = 'Catalyst::Engine::Apache2::MP20';
1690 elsif ( $version >= 1.9901 ) {
1691 $engine = 'Catalyst::Engine::Apache2::MP19';
1694 elsif ( $version >= 1.24 ) {
1695 $engine = 'Catalyst::Engine::Apache::MP13';
1699 Catalyst::Exception->throw( message =>
1700 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1705 # install the correct mod_perl handler
1706 if ( $version >= 1.9901 ) {
1707 *handler = sub : method {
1708 shift->handle_request(@_);
1712 *handler = sub ($$) { shift->handle_request(@_) };
1717 elsif ( $software eq 'Zeus-Perl' ) {
1718 $engine = 'Catalyst::Engine::Zeus';
1722 Catalyst::Exception->throw(
1723 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1728 $engine = $class->engine_class;
1734 Catalyst::Exception->throw( message =>
1735 qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1739 # check for old engines that are no longer compatible
1741 if ( $engine->isa('Catalyst::Engine::Apache')
1742 && !Catalyst::Engine::Apache->VERSION )
1747 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
1748 && Catalyst::Engine::Server->VERSION le '0.02' )
1753 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1754 && $engine->VERSION eq '0.01' )
1759 elsif ($engine->isa('Catalyst::Engine::Zeus')
1760 && $engine->VERSION eq '0.01' )
1766 Catalyst::Exception->throw( message =>
1767 qq/Engine "$engine" is not supported by this version of Catalyst/
1772 $class->engine( $engine->new );
1775 =head2 $c->setup_home
1777 Sets up the home directory.
1782 my ( $class, $home ) = @_;
1784 if ( $ENV{CATALYST_HOME} ) {
1785 $home = $ENV{CATALYST_HOME};
1788 if ( $ENV{ uc($class) . '_HOME' } ) {
1789 $home = $ENV{ uc($class) . '_HOME' };
1793 $home = Catalyst::Utils::home($class);
1797 $class->config->{home} ||= $home;
1798 $class->config->{root} ||= dir($home)->subdir('root');
1802 =head2 $c->setup_log
1809 my ( $class, $debug ) = @_;
1811 unless ( $class->log ) {
1812 $class->log( Catalyst::Log->new );
1815 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
1818 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1819 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1824 *{"$class\::debug"} = sub { 1 };
1825 $class->log->debug('Debug messages enabled');
1829 =head2 $c->setup_plugins
1836 my ( $class, $plugins ) = @_;
1839 for my $plugin ( reverse @$plugins ) {
1841 $plugin = "Catalyst::Plugin::$plugin";
1846 Catalyst::Exception->throw(
1847 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1852 unshift @{"$class\::ISA"}, $plugin;
1861 =head2 $c->write( $data )
1863 Writes $data to the output stream. When using this method directly, you
1864 will need to manually set the C<Content-Length> header to the length of
1865 your output data, if known.
1872 # Finalize headers if someone manually writes output
1873 $c->finalize_headers;
1875 return $c->engine->write( $c, @_ );
1880 Returns the Catalyst version number. Mostly useful for "powered by"
1881 messages in template systems.
1885 sub version { return $Catalyst::VERSION }
1887 =head1 INTERNAL ACTIONS
1889 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
1890 C<_ACTION>, and C<_END>. These are by default not shown in the private
1891 action table, but you can make them visible with a config parameter.
1893 MyApp->config->{show_internal_actions} = 1;
1895 =head1 CASE SENSITIVITY
1897 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
1898 mapped to C</foo/bar>. You can activate case sensitivity with a config
1901 MyApp->config->{case_sensitive} = 1;
1903 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
1905 =head1 ON-DEMAND PARSER
1907 The request body is usually parsed at the beginning of a request,
1908 but if you want to handle input yourself or speed things up a bit,
1909 you can enable on-demand parsing with a config parameter.
1911 MyApp->config->{parse_on_demand} = 1;
1913 =head1 PROXY SUPPORT
1915 Many production servers operate using the common double-server approach,
1916 with a lightweight frontend web server passing requests to a larger
1917 backend server. An application running on the backend server must deal
1918 with two problems: the remote user always appears to be C<127.0.0.1> and
1919 the server's hostname will appear to be C<localhost> regardless of the
1920 virtual host that the user connected through.
1922 Catalyst will automatically detect this situation when you are running
1923 the frontend and backend servers on the same machine. The following
1924 changes are made to the request.
1926 $c->req->address is set to the user's real IP address, as read from
1927 the HTTP X-Forwarded-For header.
1929 The host value for $c->req->base and $c->req->uri is set to the real
1930 host, as read from the HTTP X-Forwarded-Host header.
1932 Obviously, your web server must support these headers for this to work.
1934 In a more complex server farm environment where you may have your
1935 frontend proxy server(s) on different machines, you will need to set a
1936 configuration option to tell Catalyst to read the proxied data from the
1939 MyApp->config->{using_frontend_proxy} = 1;
1941 If you do not wish to use the proxy support at all, you may set:
1943 MyApp->config->{ignore_frontend_proxy} = 1;
1945 =head1 THREAD SAFETY
1947 Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1948 and the standalone forking HTTP server on Windows. We believe the Catalyst
1949 core to be thread-safe.
1951 If you plan to operate in a threaded environment, remember that all other
1952 modules you are using must also be thread-safe. Some modules, most notably
1953 L<DBD::SQLite>, are not thread-safe.
1959 Join #catalyst on irc.perl.org.
1963 http://lists.rawmode.org/mailman/listinfo/catalyst
1964 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1968 http://catalyst.perl.org
1972 http://dev.catalyst.perl.org
1976 =head2 L<Task::Catalyst> - All you need to start with Catalyst
1978 =head2 L<Catalyst::Manual> - The Catalyst Manual
1980 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1982 =head2 L<Catalyst::Engine> - Core engine
1984 =head2 L<Catalyst::Log> - Log class.
1986 =head2 L<Catalyst::Request> - Request object
1988 =head2 L<Catalyst::Response> - Response object
1990 =head2 L<Catalyst::Test> - The test suite.
2060 Sebastian Riedel, C<sri@oook.de>
2064 This library is free software, you can redistribute it and/or modify it under
2065 the same terms as Perl itself.