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;
17 require Module::Pluggable::Fast;
20 $Data::Dumper::Terse = 1;
22 __PACKAGE__->mk_classdata('components');
23 __PACKAGE__->mk_accessors(qw/request response state/);
35 Catalyst::Engine - The Catalyst Engine
47 =item $c->benchmark($coderef)
49 Takes a coderef with arguments and returns elapsed time as float.
51 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
52 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
59 my $time = [gettimeofday];
60 my @return = &$code(@_);
61 my $elapsed = tv_interval $time;
62 return wantarray ? ( $elapsed, @return ) : $elapsed;
67 =item $c->component($name)
69 Get a component object by name.
71 $c->comp('MyApp::Model::MyModel')->do_stuff;
73 Regex search for a component.
75 $c->comp('mymodel')->do_stuff;
80 my ( $c, $name ) = @_;
82 if ( my $component = $c->components->{$name} ) {
87 for my $component ( keys %{ $c->components } ) {
88 return $c->components->{$component} if $component =~ /$name/i;
96 =item $c->error($error, ...)
98 =item $c->error($arrayref)
100 Returns an arrayref containing error messages.
102 my @error = @{ $c->error };
106 $c->error('Something bad happened');
112 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
113 push @{ $c->{error} }, @$error;
117 =item $c->execute($class, $coderef)
119 Execute a coderef in given class and catch exceptions.
120 Errors are available via $c->error.
125 my ( $c, $class, $code ) = @_;
126 $class = $c->comp($class) || $class;
128 my $callsub = ( caller(1) )[3];
133 my $action = $c->actions->{reverse}->{"$code"};
134 $action = "/$action" unless $action =~ /\-\>/;
135 $action = "-> $action" if $callsub =~ /forward$/;
136 my ( $elapsed, @state ) =
137 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
138 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
141 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
144 if ( my $error = $@ ) {
146 unless ( ref $error ) {
148 $error = qq/Caught exception "$error"/;
151 $c->log->error($error);
167 $c->finalize_cookies;
169 if ( my $location = $c->response->redirect ) {
170 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
171 $c->response->header( Location => $location );
172 $c->response->status(302) if $c->response->status !~ /^3\d\d$/;
175 if ( $#{ $c->error } >= 0 ) {
179 if ( !$c->response->output && $c->response->status !~ /^(1|3)\d\d$/ ) {
183 if ( $c->response->output && !$c->response->content_length ) {
184 use bytes; # play safe with a utf8 aware perl
185 $c->response->content_length( length $c->response->output );
188 my $status = $c->finalize_headers;
193 =item $c->finalize_cookies
199 sub finalize_cookies {
202 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
203 my $cookie = CGI::Cookie->new(
205 -value => $cookie->{value},
206 -expires => $cookie->{expires},
207 -domain => $cookie->{domain},
208 -path => $cookie->{path},
209 -secure => $cookie->{secure} || 0
212 $c->res->headers->push_header( 'Set-Cookie' => $cookie->as_string );
216 =item $c->finalize_error
225 $c->res->headers->content_type('text/html');
226 my $name = $c->config->{name} || 'Catalyst Application';
228 my ( $title, $error, $infos );
230 $error = join '<br/>', @{ $c->error };
231 $error ||= 'No output';
232 $title = $name = "$name on Catalyst $Catalyst::VERSION";
233 my $req = encode_entities Dumper $c->req;
234 my $res = encode_entities Dumper $c->res;
235 my $stash = encode_entities Dumper $c->stash;
238 <b><u>Request</u></b><br/>
240 <b><u>Response</u></b><br/>
242 <b><u>Stash</u></b><br/>
251 (en) Please come back later
252 (de) Bitte versuchen sie es spaeter nocheinmal
253 (nl) Gelieve te komen later terug
254 (no) Vennligst prov igjen senere
255 (fr) Veuillez revenir plus tard
256 (es) Vuelto por favor mas adelante
257 (pt) Voltado por favor mais tarde
258 (it) Ritornato prego piĆ¹ successivamente
263 $c->res->output( <<"" );
266 <title>$title</title>
267 <style type="text/css">
269 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
270 Tahoma, Arial, helvetica, sans-serif;
272 background-color: #eee;
277 background-color: #ccc;
278 border: 1px solid #aaa;
281 -moz-border-radius: 10px;
284 background-color: #977;
285 border: 1px solid #755;
289 -moz-border-radius: 10px;
292 background-color: #797;
293 border: 1px solid #575;
297 -moz-border-radius: 10px;
300 background-color: #779;
301 border: 1px solid #557;
304 -moz-border-radius: 10px;
310 <div class="error">$error</div>
311 <div class="infos">$infos</div>
312 <div class="name">$name</div>
319 =item $c->finalize_headers
325 sub finalize_headers { }
327 =item $c->finalize_output
333 sub finalize_output { }
335 =item $c->handler( $class, $r )
342 my ( $class, $engine ) = @_;
344 # Always expect worst case!
350 my $c = $class->prepare($engine);
351 $c->{stats} = \@stats;
356 if ( $class->debug ) {
358 ( $elapsed, $status ) = $class->benchmark($handler);
359 $elapsed = sprintf '%f', $elapsed;
360 my $av = sprintf '%.3f', 1 / $elapsed;
361 my $t = Text::ASCIITable->new;
362 $t->setCols( 'Action', 'Time' );
363 $t->setColWidth( 'Action', 64, 1 );
364 $t->setColWidth( 'Time', 9, 1 );
366 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
367 $class->log->info( "Request took $elapsed" . "s ($av/s)",
370 else { $status = &$handler }
374 if ( my $error = $@ ) {
376 $class->log->error(qq/Caught exception in engine "$error"/);
383 =item $c->prepare($r)
385 Turns the engine-specific request( Apache, CGI ... )
386 into a Catalyst context .
391 my ( $class, $r ) = @_;
394 request => Catalyst::Request->new(
398 headers => HTTP::Headers->new,
404 response => Catalyst::Response->new(
405 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
412 my $secs = time - $START || 1;
413 my $av = sprintf '%.3f', $COUNT / $secs;
414 $c->log->debug('**********************************');
415 $c->log->debug("* Request $COUNT ($av/s) [$$]");
416 $c->log->debug('**********************************');
417 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
420 $c->prepare_request($r);
425 $c->prepare_connection;
427 my $method = $c->req->method || '';
428 my $path = $c->req->path || '';
429 my $hostname = $c->req->hostname || '';
430 my $address = $c->req->address || '';
431 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
435 $c->prepare_parameters;
437 if ( $c->debug && keys %{ $c->req->params } ) {
438 my $t = Text::ASCIITable->new;
439 $t->setCols( 'Key', 'Value' );
440 $t->setColWidth( 'Key', 37, 1 );
441 $t->setColWidth( 'Value', 36, 1 );
442 for my $key ( keys %{ $c->req->params } ) {
443 my $value = $c->req->params->{$key} || '';
444 $t->addRow( $key, $value );
446 $c->log->debug( 'Parameters are', $t->draw );
453 =item $c->prepare_action
461 my $path = $c->req->path;
462 my @path = split /\//, $c->req->path;
463 $c->req->args( \my @args );
466 $path = join '/', @path;
467 if ( my $result = ${ $c->get_action($path) }[0] ) {
471 my $match = $result->[1];
472 my @snippets = @{ $result->[2] };
474 qq/Requested action is "$path" and matched "$match"/)
477 'Snippets are "' . join( ' ', @snippets ) . '"' )
478 if ( $c->debug && @snippets );
479 $c->req->action($match);
480 $c->req->snippets( \@snippets );
484 $c->req->action($path);
485 $c->log->debug(qq/Requested action is "$path"/) if $c->debug;
488 $c->req->match($path);
491 unshift @args, pop @path;
494 unless ( $c->req->action ) {
495 $c->req->action('default');
499 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
500 if ( $c->debug && @args );
503 =item $c->prepare_connection
509 sub prepare_connection { }
511 =item $c->prepare_cookies
517 sub prepare_cookies {
520 if ( my $header = $c->request->header('Cookie') ) {
521 $c->req->cookies( { CGI::Cookie->parse($header) } );
525 =item $c->prepare_headers
531 sub prepare_headers { }
533 =item $c->prepare_parameters
539 sub prepare_input { }
541 =item $c->prepare_input
543 Prepare message body.
547 sub prepare_parameters { }
549 =item $c->prepare_path
551 Prepare path and base.
557 =item $c->prepare_request
559 Prepare the engine request.
563 sub prepare_request { }
565 =item $c->prepare_uploads
571 sub prepare_uploads { }
585 Returns a C<Catalyst::Request> object.
593 Returns a C<Catalyst::Response> object.
607 $self->setup_components;
608 if ( $self->debug ) {
609 my $name = $self->config->{name} || 'Application';
610 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
614 =item $class->setup_components
620 sub setup_components {
624 my $class = ref $self || $self;
627 import Module::Pluggable::Fast
628 name => '_components',
630 '$class\::Controller', '$class\::C',
631 '$class\::Model', '$class\::M',
632 '$class\::View', '$class\::V'
635 if ( my $error = $@ ) {
637 die qq/Couldn't load components "$error"/;
640 $self->components( {} );
642 for my $comp ( $self->_components($self) ) {
643 $self->components->{ ref $comp } = $comp;
647 my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
648 $t->setCols('Class');
649 $t->setColWidth( 'Class', 75, 1 );
650 $t->addRow($_) for keys %{ $self->components };
651 $self->log->debug( 'Loaded components', $t->draw )
652 if ( @{ $t->{tbl_rows} } && $self->debug );
654 $self->setup_actions( [ $self, @comps ] );
659 Contains the return value of the last executed action.
663 Returns a hashref containing all your data.
665 $c->stash->{foo} ||= 'yada';
666 print $c->stash->{foo};
673 my $stash = $_[1] ? {@_} : $_[0];
674 while ( my ( $key, $val ) = each %$stash ) {
675 $self->{stash}->{$key} = $val;
678 return $self->{stash};
685 Sebastian Riedel, C<sri@cpan.org>
689 This program is free software, you can redistribute it and/or modify it under
690 the same terms as Perl itself.