1 package Catalyst::Engine;
4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
6 use UNIVERSAL::require;
11 use Time::HiRes qw/gettimeofday tv_interval/;
13 use Catalyst::Request;
14 use Catalyst::Request::Upload;
15 use Catalyst::Response;
18 require Module::Pluggable::Fast;
21 $Data::Dumper::Terse = 1;
23 __PACKAGE__->mk_classdata('components');
24 __PACKAGE__->mk_accessors(qw/counter request response state/);
30 # For backwards compatibility
31 *finalize_output = \&finalize_body;
36 our $RECURSION = 1000;
40 Catalyst::Engine - The Catalyst Engine
52 =item $c->benchmark($coderef)
54 Takes a coderef with arguments and returns elapsed time as float.
56 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
57 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
64 my $time = [gettimeofday];
65 my @return = &$code(@_);
66 my $elapsed = tv_interval $time;
67 return wantarray ? ( $elapsed, @return ) : $elapsed;
72 =item $c->component($name)
74 Get a component object by name.
76 $c->comp('MyApp::Model::MyModel')->do_stuff;
78 Regex search for a component.
80 $c->comp('mymodel')->do_stuff;
91 if ( my $component = $c->components->{$name} ) {
96 for my $component ( keys %{ $c->components } ) {
97 return $c->components->{$component} if $component =~ /$name/i;
102 return sort keys %{ $c->components };
107 Returns a hashref containing coderefs and execution counts.
108 (Needed for deep recursion detection)
112 =item $c->error($error, ...)
114 =item $c->error($arrayref)
116 Returns an arrayref containing error messages.
118 my @error = @{ $c->error };
122 $c->error('Something bad happened');
128 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
129 push @{ $c->{error} }, @$error;
133 =item $c->execute($class, $coderef)
135 Execute a coderef in given class and catch exceptions.
136 Errors are available via $c->error.
141 my ( $c, $class, $code ) = @_;
142 $class = $c->components->{$class} || $class;
144 my $callsub = ( caller(1) )[3];
148 $action = $c->actions->{reverse}->{"$code"};
149 $action = "/$action" unless $action =~ /\-\>/;
150 $c->counter->{"$code"}++;
152 if ( $c->counter->{"$code"} > $RECURSION ) {
153 my $error = qq/Deep recursion detected in "$action"/;
154 $c->log->error($error);
160 $action = "-> $action" if $callsub =~ /forward$/;
166 my ( $elapsed, @state ) = $c->benchmark( $code, $class, $c, @{ $c->req->args } );
167 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
170 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
173 if ( my $error = $@ ) {
175 unless ( ref $error ) {
177 $error = qq/Caught exception "$error"/;
180 $c->log->error($error);
196 $c->finalize_cookies;
198 if ( my $location = $c->response->redirect ) {
199 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
200 $c->response->header( Location => $location );
201 $c->response->status(302) if $c->response->status !~ /^3\d\d$/;
204 if ( $#{ $c->error } >= 0 ) {
208 if ( !$c->response->body && $c->response->status == 200 ) {
212 if ( $c->response->body && !$c->response->content_length ) {
213 $c->response->content_length( bytes::length( $c->response->body ) );
216 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
217 $c->response->headers->remove_header("Content-Length");
218 $c->response->body('');
221 if ( $c->request->method eq 'HEAD' ) {
222 $c->response->body('');
225 my $status = $c->finalize_headers;
230 =item $c->finalize_output
232 <obsolete>, see finalize_body
234 =item $c->finalize_body
240 sub finalize_body { }
242 =item $c->finalize_cookies
248 sub finalize_cookies {
251 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
252 my $cookie = CGI::Cookie->new(
254 -value => $cookie->{value},
255 -expires => $cookie->{expires},
256 -domain => $cookie->{domain},
257 -path => $cookie->{path},
258 -secure => $cookie->{secure} || 0
261 $c->res->headers->push_header( 'Set-Cookie' => $cookie->as_string );
265 =item $c->finalize_error
274 $c->res->headers->content_type('text/html');
275 my $name = $c->config->{name} || 'Catalyst Application';
277 my ( $title, $error, $infos );
279 $error = join '<br/>', @{ $c->error };
280 $error ||= 'No output';
281 $title = $name = "$name on Catalyst $Catalyst::VERSION";
282 my $req = encode_entities Dumper $c->req;
283 my $res = encode_entities Dumper $c->res;
284 my $stash = encode_entities Dumper $c->stash;
287 <b><u>Request</u></b><br/>
289 <b><u>Response</u></b><br/>
291 <b><u>Stash</u></b><br/>
300 (en) Please come back later
301 (de) Bitte versuchen sie es spaeter nocheinmal
302 (nl) Gelieve te komen later terug
303 (no) Vennligst prov igjen senere
304 (fr) Veuillez revenir plus tard
305 (es) Vuelto por favor mas adelante
306 (pt) Voltado por favor mais tarde
307 (it) Ritornato prego piĆ¹ successivamente
312 $c->res->body( <<"" );
315 <title>$title</title>
316 <style type="text/css">
318 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
319 Tahoma, Arial, helvetica, sans-serif;
321 background-color: #eee;
326 background-color: #ccc;
327 border: 1px solid #aaa;
330 -moz-border-radius: 10px;
333 background-color: #977;
334 border: 1px solid #755;
338 -moz-border-radius: 10px;
341 background-color: #797;
342 border: 1px solid #575;
346 -moz-border-radius: 10px;
349 background-color: #779;
350 border: 1px solid #557;
353 -moz-border-radius: 10px;
359 <div class="error">$error</div>
360 <div class="infos">$infos</div>
361 <div class="name">$name</div>
368 =item $c->finalize_headers
374 sub finalize_headers { }
376 =item $c->handler( $class, @arguments )
383 my ( $class, @arguments ) = @_;
385 # Always expect worst case!
391 my $c = $class->prepare(@arguments);
392 $c->{stats} = \@stats;
397 if ( $class->debug ) {
399 ( $elapsed, $status ) = $class->benchmark($handler);
400 $elapsed = sprintf '%f', $elapsed;
401 my $av = sprintf '%.3f',
402 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
403 my $t = Text::ASCIITable->new;
404 $t->setCols( 'Action', 'Time' );
405 $t->setColWidth( 'Action', 64, 1 );
406 $t->setColWidth( 'Time', 9, 1 );
408 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
409 $class->log->info( "Request took $elapsed" . "s ($av/s)",
412 else { $status = &$handler }
416 if ( my $error = $@ ) {
418 $class->log->error(qq/Caught exception in engine "$error"/);
425 =item $c->prepare(@arguments)
427 Turns the engine-specific request( Apache, CGI ... )
428 into a Catalyst context .
433 my ( $class, @arguments ) = @_;
437 request => Catalyst::Request->new(
441 headers => HTTP::Headers->new,
448 response => Catalyst::Response->new(
452 headers => HTTP::Headers->new( 'Content-Length' => 0 ),
461 my $secs = time - $START || 1;
462 my $av = sprintf '%.3f', $COUNT / $secs;
463 $c->log->debug('**********************************');
464 $c->log->debug("* Request $COUNT ($av/s) [$$]");
465 $c->log->debug('**********************************');
466 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
469 $c->prepare_request(@arguments);
470 $c->prepare_connection;
476 my $method = $c->req->method || '';
477 my $path = $c->req->path || '';
478 my $address = $c->req->address || '';
480 $c->log->debug(qq/"$method" request for "$path" from $address/)
483 if ( $c->request->method eq 'POST' and $c->request->content_length ) {
485 if ( $c->req->content_type eq 'application/x-www-form-urlencoded' ) {
486 $c->prepare_parameters;
488 elsif ( $c->req->content_type eq 'multipart/form-data' ) {
489 $c->prepare_parameters;
497 if ( $c->request->method eq 'GET' ) {
498 $c->prepare_parameters;
501 if ( $c->debug && keys %{ $c->req->params } ) {
502 my $t = Text::ASCIITable->new;
503 $t->setCols( 'Key', 'Value' );
504 $t->setColWidth( 'Key', 37, 1 );
505 $t->setColWidth( 'Value', 36, 1 );
506 for my $key ( sort keys %{ $c->req->params } ) {
507 my $param = $c->req->params->{$key};
508 my $value = defined($param) ? $param : '';
509 $t->addRow( $key, $value );
511 $c->log->debug( 'Parameters are', $t->draw );
517 =item $c->prepare_action
525 my $path = $c->req->path;
526 my @path = split /\//, $c->req->path;
527 $c->req->args( \my @args );
530 $path = join '/', @path;
531 if ( my $result = ${ $c->get_action($path) }[0] ) {
535 my $match = $result->[1];
536 my @snippets = @{ $result->[2] };
538 qq/Requested action is "$path" and matched "$match"/)
541 'Snippets are "' . join( ' ', @snippets ) . '"' )
542 if ( $c->debug && @snippets );
543 $c->req->action($match);
544 $c->req->snippets( \@snippets );
548 $c->req->action($path);
549 $c->log->debug(qq/Requested action is "$path"/) if $c->debug;
552 $c->req->match($path);
555 unshift @args, pop @path;
558 unless ( $c->req->action ) {
559 $c->req->action('default');
563 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
564 if ( $c->debug && @args );
567 =item $c->prepare_body
569 Prepare message body.
575 =item $c->prepare_connection
581 sub prepare_connection { }
583 =item $c->prepare_cookies
589 sub prepare_cookies {
592 if ( my $header = $c->request->header('Cookie') ) {
593 $c->req->cookies( { CGI::Cookie->parse($header) } );
597 =item $c->prepare_headers
603 sub prepare_headers { }
605 =item $c->prepare_parameters
611 sub prepare_parameters { }
613 =item $c->prepare_path
615 Prepare path and base.
621 =item $c->prepare_request
623 Prepare the engine request.
627 sub prepare_request { }
629 =item $c->prepare_uploads
635 sub prepare_uploads { }
649 Returns a C<Catalyst::Request> object.
657 Returns a C<Catalyst::Response> object.
672 # Initialize our data structure
673 $self->components( {} );
675 $self->setup_components;
677 if ( $self->debug ) {
678 my $t = Text::ASCIITable->new;
679 $t->setOptions( 'hide_HeadRow', 1 );
680 $t->setOptions( 'hide_HeadLine', 1 );
681 $t->setCols('Class');
682 $t->setColWidth( 'Class', 75, 1 );
683 $t->addRow($_) for sort keys %{ $self->components };
684 $self->log->debug( 'Loaded components', $t->draw )
685 if ( @{ $t->{tbl_rows} } );
688 # Add our self to components, since we are also a component
689 $self->components->{ $self } = $self;
691 $self->setup_actions;
693 if ( $self->debug ) {
694 my $name = $self->config->{name} || 'Application';
695 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
699 =item $class->setup_components
705 sub setup_components {
709 my ( $component, $context ) = @_;
711 unless ( $component->isa('Catalyst::Base') ) {
715 my $suffix = Catalyst::Utils::class2classsuffix($component);
716 my $config = $self->config->{$suffix} || {};
721 $instance = $component->new( $context, $config );
724 if ( my $error = $@ ) {
726 die qq/Couldn't instantiate component "$component", "$error"/;
733 Module::Pluggable::Fast->import(
734 name => '_components',
736 "$self\::Controller", "$self\::C",
737 "$self\::Model", "$self\::M",
738 "$self\::View", "$self\::V"
740 callback => $callback
744 if ( my $error = $@ ) {
746 die qq/Couldn't load components "$error"/;
749 for my $component ( $self->_components($self) ) {
750 $self->components->{ ref $component || $component } = $component;
756 Contains the return value of the last executed action.
760 Returns a hashref containing all your data.
762 $c->stash->{foo} ||= 'yada';
763 print $c->stash->{foo};
770 my $stash = @_ > 1 ? {@_} : $_[0];
771 while ( my ( $key, $val ) = each %$stash ) {
772 $self->{stash}->{$key} = $val;
775 return $self->{stash};
782 Sebastian Riedel, C<sri@cpan.org>
786 This program is free software, you can redistribute it and/or modify it under
787 the same terms as Perl itself.