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/);
29 # For backwards compatibility
30 *finalize_output = \&finalize_body;
38 Catalyst::Engine - The Catalyst Engine
50 =item $c->benchmark($coderef)
52 Takes a coderef with arguments and returns elapsed time as float.
54 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
55 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
62 my $time = [gettimeofday];
63 my @return = &$code(@_);
64 my $elapsed = tv_interval $time;
65 return wantarray ? ( $elapsed, @return ) : $elapsed;
70 =item $c->component($name)
72 Get a component object by name.
74 $c->comp('MyApp::Model::MyModel')->do_stuff;
76 Regex search for a component.
78 $c->comp('mymodel')->do_stuff;
83 my ( $c, $name ) = @_;
85 if ( my $component = $c->components->{$name} ) {
90 for my $component ( keys %{ $c->components } ) {
91 return $c->components->{$component} if $component =~ /$name/i;
99 =item $c->error($error, ...)
101 =item $c->error($arrayref)
103 Returns an arrayref containing error messages.
105 my @error = @{ $c->error };
109 $c->error('Something bad happened');
115 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
116 push @{ $c->{error} }, @$error;
120 =item $c->execute($class, $coderef)
122 Execute a coderef in given class and catch exceptions.
123 Errors are available via $c->error.
128 my ( $c, $class, $code ) = @_;
129 $class = $c->comp($class) || $class;
131 my $callsub = ( caller(1) )[3];
136 my $action = $c->actions->{reverse}->{"$code"};
137 $action = "/$action" unless $action =~ /\-\>/;
138 $action = "-> $action" if $callsub =~ /forward$/;
139 my ( $elapsed, @state ) =
140 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
141 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
144 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
147 if ( my $error = $@ ) {
149 unless ( ref $error ) {
151 $error = qq/Caught exception "$error"/;
154 $c->log->error($error);
170 $c->finalize_cookies;
172 if ( my $location = $c->response->redirect ) {
173 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
174 $c->response->header( Location => $location );
175 $c->response->status(302) if $c->response->status !~ /^3\d\d$/;
178 if ( $#{ $c->error } >= 0 ) {
182 if ( !$c->response->body && $c->response->status !~ /^(1|3)\d\d$/ ) {
186 if ( $c->response->body && !$c->response->content_length ) {
187 use bytes; # play safe with a utf8 aware perl
188 $c->response->content_length( length $c->response->body );
191 my $status = $c->finalize_headers;
196 =item $c->finalize_body
202 sub finalize_body { }
204 =item $c->finalize_cookies
210 sub finalize_cookies {
213 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
214 my $cookie = CGI::Cookie->new(
216 -value => $cookie->{value},
217 -expires => $cookie->{expires},
218 -domain => $cookie->{domain},
219 -path => $cookie->{path},
220 -secure => $cookie->{secure} || 0
223 $c->res->headers->push_header( 'Set-Cookie' => $cookie->as_string );
227 =item $c->finalize_error
236 $c->res->headers->content_type('text/html');
237 my $name = $c->config->{name} || 'Catalyst Application';
239 my ( $title, $error, $infos );
241 $error = join '<br/>', @{ $c->error };
242 $error ||= 'No output';
243 $title = $name = "$name on Catalyst $Catalyst::VERSION";
244 my $req = encode_entities Dumper $c->req;
245 my $res = encode_entities Dumper $c->res;
246 my $stash = encode_entities Dumper $c->stash;
249 <b><u>Request</u></b><br/>
251 <b><u>Response</u></b><br/>
253 <b><u>Stash</u></b><br/>
262 (en) Please come back later
263 (de) Bitte versuchen sie es spaeter nocheinmal
264 (nl) Gelieve te komen later terug
265 (no) Vennligst prov igjen senere
266 (fr) Veuillez revenir plus tard
267 (es) Vuelto por favor mas adelante
268 (pt) Voltado por favor mais tarde
269 (it) Ritornato prego piĆ¹ successivamente
274 $c->res->body( <<"" );
277 <title>$title</title>
278 <style type="text/css">
280 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
281 Tahoma, Arial, helvetica, sans-serif;
283 background-color: #eee;
288 background-color: #ccc;
289 border: 1px solid #aaa;
292 -moz-border-radius: 10px;
295 background-color: #977;
296 border: 1px solid #755;
300 -moz-border-radius: 10px;
303 background-color: #797;
304 border: 1px solid #575;
308 -moz-border-radius: 10px;
311 background-color: #779;
312 border: 1px solid #557;
315 -moz-border-radius: 10px;
321 <div class="error">$error</div>
322 <div class="infos">$infos</div>
323 <div class="name">$name</div>
330 =item $c->finalize_headers
336 sub finalize_headers { }
338 =item $c->handler( $class, $engine )
345 my ( $class, $engine ) = @_;
347 # Always expect worst case!
353 my $c = $class->prepare($engine);
354 $c->{stats} = \@stats;
359 if ( $class->debug ) {
361 ( $elapsed, $status ) = $class->benchmark($handler);
362 $elapsed = sprintf '%f', $elapsed;
363 my $av = sprintf '%.3f', 1 / $elapsed;
364 my $t = Text::ASCIITable->new;
365 $t->setCols( 'Action', 'Time' );
366 $t->setColWidth( 'Action', 64, 1 );
367 $t->setColWidth( 'Time', 9, 1 );
369 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
370 $class->log->info( "Request took $elapsed" . "s ($av/s)",
373 else { $status = &$handler }
377 if ( my $error = $@ ) {
379 $class->log->error(qq/Caught exception in engine "$error"/);
386 =item $c->prepare($r)
388 Turns the engine-specific request( Apache, CGI ... )
389 into a Catalyst context .
394 my ( $class, $engine ) = @_;
397 request => Catalyst::Request->new(
401 headers => HTTP::Headers->new,
407 response => Catalyst::Response->new(
408 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
415 my $secs = time - $START || 1;
416 my $av = sprintf '%.3f', $COUNT / $secs;
417 $c->log->debug('**********************************');
418 $c->log->debug("* Request $COUNT ($av/s) [$$]");
419 $c->log->debug('**********************************');
420 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
423 $c->prepare_request($engine);
427 $c->prepare_connection;
430 my $method = $c->req->method || '';
431 my $path = $c->req->path || '';
432 my $hostname = $c->req->hostname || '';
433 my $address = $c->req->address || '';
435 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
438 if ( $c->request->method eq 'POST' and $c->request->content_length ) {
440 if ( $c->req->content_type eq 'application/x-www-form-urlencoded' ) {
441 $c->prepare_parameters;
443 elsif ( $c->req->content_type eq 'multipart/form-data' ) {
444 $c->prepare_parameters;
452 if ( $c->request->method eq 'GET' ) {
453 $c->prepare_parameters;
456 if ( $c->debug && keys %{ $c->req->params } ) {
457 my $t = Text::ASCIITable->new;
458 $t->setCols( 'Key', 'Value' );
459 $t->setColWidth( 'Key', 37, 1 );
460 $t->setColWidth( 'Value', 36, 1 );
461 for my $key ( keys %{ $c->req->params } ) {
462 my $value = $c->req->params->{$key} || '';
463 $t->addRow( $key, $value );
465 $c->log->debug( 'Parameters are', $t->draw );
471 =item $c->prepare_action
479 my $path = $c->req->path;
480 my @path = split /\//, $c->req->path;
481 $c->req->args( \my @args );
484 $path = join '/', @path;
485 if ( my $result = ${ $c->get_action($path) }[0] ) {
489 my $match = $result->[1];
490 my @snippets = @{ $result->[2] };
492 qq/Requested action is "$path" and matched "$match"/)
495 'Snippets are "' . join( ' ', @snippets ) . '"' )
496 if ( $c->debug && @snippets );
497 $c->req->action($match);
498 $c->req->snippets( \@snippets );
502 $c->req->action($path);
503 $c->log->debug(qq/Requested action is "$path"/) if $c->debug;
506 $c->req->match($path);
509 unshift @args, pop @path;
512 unless ( $c->req->action ) {
513 $c->req->action('default');
517 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
518 if ( $c->debug && @args );
521 =item $c->prepare_body
523 Prepare message body.
529 =item $c->prepare_connection
535 sub prepare_connection { }
537 =item $c->prepare_cookies
543 sub prepare_cookies {
546 if ( my $header = $c->request->header('Cookie') ) {
547 $c->req->cookies( { CGI::Cookie->parse($header) } );
551 =item $c->prepare_headers
557 sub prepare_headers { }
559 =item $c->prepare_parameters
565 sub prepare_parameters { }
567 =item $c->prepare_path
569 Prepare path and base.
575 =item $c->prepare_request
577 Prepare the engine request.
581 sub prepare_request { }
583 =item $c->prepare_uploads
589 sub prepare_uploads { }
603 Returns a C<Catalyst::Request> object.
611 Returns a C<Catalyst::Response> object.
625 $self->setup_components;
626 if ( $self->debug ) {
627 my $name = $self->config->{name} || 'Application';
628 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
632 =item $class->setup_components
638 sub setup_components {
642 my $class = ref $self || $self;
645 import Module::Pluggable::Fast
646 name => '_components',
648 '$class\::Controller', '$class\::C',
649 '$class\::Model', '$class\::M',
650 '$class\::View', '$class\::V'
653 if ( my $error = $@ ) {
655 die qq/Couldn't load components "$error"/;
658 $self->components( {} );
660 for my $comp ( $self->_components($self) ) {
661 $self->components->{ ref $comp } = $comp;
665 my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
666 $t->setCols('Class');
667 $t->setColWidth( 'Class', 75, 1 );
668 $t->addRow($_) for keys %{ $self->components };
669 $self->log->debug( 'Loaded components', $t->draw )
670 if ( @{ $t->{tbl_rows} } && $self->debug );
672 $self->setup_actions( [ $self, @comps ] );
677 Contains the return value of the last executed action.
681 Returns a hashref containing all your data.
683 $c->stash->{foo} ||= 'yada';
684 print $c->stash->{foo};
691 my $stash = $_[1] ? {@_} : $_[0];
692 while ( my ( $key, $val ) = each %$stash ) {
693 $self->{stash}->{$key} = $val;
696 return $self->{stash};
703 Sebastian Riedel, C<sri@cpan.org>
707 This program is free software, you can redistribute it and/or modify it under
708 the same terms as Perl itself.