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::Exception;
14 use Catalyst::Request;
15 use Catalyst::Request::Upload;
16 use Catalyst::Response;
19 require Module::Pluggable::Fast;
22 $Data::Dumper::Terse = 1;
24 __PACKAGE__->mk_classdata('components');
25 __PACKAGE__->mk_accessors(qw/counter depth request response state/);
31 # For backwards compatibility
32 *finalize_output = \&finalize_body;
37 our $RECURSION = 1000;
38 our $DETACH = "catalyst_detach\n";
42 Catalyst::Engine - The Catalyst Engine
54 =item $c->benchmark($coderef)
56 Takes a coderef with arguments and returns elapsed time as float.
58 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
59 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
66 my $time = [gettimeofday];
67 my @return = &$code(@_);
68 my $elapsed = tv_interval $time;
69 return wantarray ? ( $elapsed, @return ) : $elapsed;
74 =item $c->component($name)
76 Get a component object by name.
78 $c->comp('MyApp::Model::MyModel')->do_stuff;
80 Regex search for a component.
82 $c->comp('mymodel')->do_stuff;
93 if ( my $component = $c->components->{$name} ) {
98 for my $component ( keys %{ $c->components } ) {
99 return $c->components->{$component} if $component =~ /$name/i;
104 return sort keys %{ $c->components };
109 Returns a hashref containing coderefs and execution counts.
110 (Needed for deep recursion detection)
114 Returns the actual forward depth.
118 =item $c->error($error, ...)
120 =item $c->error($arrayref)
122 Returns an arrayref containing error messages.
124 my @error = @{ $c->error };
128 $c->error('Something bad happened');
134 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
135 push @{ $c->{error} }, @$error;
139 =item $c->execute($class, $coderef)
141 Execute a coderef in given class and catch exceptions.
142 Errors are available via $c->error.
147 my ( $c, $class, $code ) = @_;
148 $class = $c->components->{$class} || $class;
150 my $callsub = ( caller(1) )[3];
154 $action = $c->actions->{reverse}->{"$code"};
155 $action = "/$action" unless $action =~ /\-\>/;
156 $c->counter->{"$code"}++;
158 if ( $c->counter->{"$code"} > $RECURSION ) {
159 my $error = qq/Deep recursion detected in "$action"/;
160 $c->log->error($error);
166 $action = "-> $action" if $callsub =~ /forward$/;
173 my ( $elapsed, @state ) =
174 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
175 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
178 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
182 if ( my $error = $@ ) {
184 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
186 unless ( ref $error ) {
188 $error = qq/Caught exception "$error"/;
191 $c->log->error($error);
208 $c->finalize_cookies;
210 if ( my $location = $c->response->redirect ) {
211 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
212 $c->response->header( Location => $location );
213 $c->response->status(302) if $c->response->status !~ /^3\d\d$/;
216 if ( $#{ $c->error } >= 0 ) {
220 if ( !$c->response->body && $c->response->status == 200 ) {
224 if ( $c->response->body && !$c->response->content_length ) {
225 $c->response->content_length( bytes::length( $c->response->body ) );
228 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
229 $c->response->headers->remove_header("Content-Length");
230 $c->response->body('');
233 if ( $c->request->method eq 'HEAD' ) {
234 $c->response->body('');
237 my $status = $c->finalize_headers;
242 =item $c->finalize_output
244 <obsolete>, see finalize_body
246 =item $c->finalize_body
252 sub finalize_body { }
254 =item $c->finalize_cookies
260 sub finalize_cookies {
263 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
264 my $cookie = CGI::Cookie->new(
266 -value => $cookie->{value},
267 -expires => $cookie->{expires},
268 -domain => $cookie->{domain},
269 -path => $cookie->{path},
270 -secure => $cookie->{secure} || 0
273 $c->res->headers->push_header( 'Set-Cookie' => $cookie->as_string );
277 =item $c->finalize_error
286 $c->res->headers->content_type('text/html');
287 my $name = $c->config->{name} || 'Catalyst Application';
289 my ( $title, $error, $infos );
291 $error = join '<br/>', @{ $c->error };
292 $error ||= 'No output';
293 $title = $name = "$name on Catalyst $Catalyst::VERSION";
294 my $req = encode_entities Dumper $c->req;
295 my $res = encode_entities Dumper $c->res;
296 my $stash = encode_entities Dumper $c->stash;
299 <b><u>Request</u></b><br/>
301 <b><u>Response</u></b><br/>
303 <b><u>Stash</u></b><br/>
312 (en) Please come back later
313 (de) Bitte versuchen sie es spaeter nocheinmal
314 (nl) Gelieve te komen later terug
315 (no) Vennligst prov igjen senere
316 (fr) Veuillez revenir plus tard
317 (es) Vuelto por favor mas adelante
318 (pt) Voltado por favor mais tarde
319 (it) Ritornato prego piĆ¹ successivamente
324 $c->res->body( <<"" );
327 <title>$title</title>
328 <style type="text/css">
330 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
331 Tahoma, Arial, helvetica, sans-serif;
333 background-color: #eee;
338 background-color: #ccc;
339 border: 1px solid #aaa;
342 -moz-border-radius: 10px;
345 background-color: #977;
346 border: 1px solid #755;
350 -moz-border-radius: 10px;
353 background-color: #797;
354 border: 1px solid #575;
358 -moz-border-radius: 10px;
361 background-color: #779;
362 border: 1px solid #557;
365 -moz-border-radius: 10px;
371 <div class="error">$error</div>
372 <div class="infos">$infos</div>
373 <div class="name">$name</div>
380 =item $c->finalize_headers
386 sub finalize_headers { }
388 =item $c->handler( $class, @arguments )
395 my ( $class, @arguments ) = @_;
397 # Always expect worst case!
403 my $c = $class->prepare(@arguments);
404 $c->{stats} = \@stats;
409 if ( $class->debug ) {
411 ( $elapsed, $status ) = $class->benchmark($handler);
412 $elapsed = sprintf '%f', $elapsed;
413 my $av = sprintf '%.3f',
414 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
415 my $t = Text::ASCIITable->new;
416 $t->setCols( 'Action', 'Time' );
417 $t->setColWidth( 'Action', 64, 1 );
418 $t->setColWidth( 'Time', 9, 1 );
420 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
421 $class->log->info( "Request took $elapsed" . "s ($av/s)",
424 else { $status = &$handler }
428 if ( my $error = $@ ) {
430 $class->log->error(qq/Caught exception in engine "$error"/);
437 =item $c->prepare(@arguments)
439 Turns the engine-specific request( Apache, CGI ... )
440 into a Catalyst context .
445 my ( $class, @arguments ) = @_;
450 request => Catalyst::Request->new(
454 headers => HTTP::Headers->new,
461 response => Catalyst::Response->new(
465 headers => HTTP::Headers->new( 'Content-Length' => 0 ),
474 my $secs = time - $START || 1;
475 my $av = sprintf '%.3f', $COUNT / $secs;
476 $c->log->debug('**********************************');
477 $c->log->debug("* Request $COUNT ($av/s) [$$]");
478 $c->log->debug('**********************************');
479 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
482 $c->prepare_request(@arguments);
483 $c->prepare_connection;
489 my $method = $c->req->method || '';
490 my $path = $c->req->path || '';
491 my $address = $c->req->address || '';
493 $c->log->debug(qq/"$method" request for "$path" from $address/)
496 if ( $c->request->method eq 'POST' and $c->request->content_length ) {
498 if ( $c->req->content_type eq 'application/x-www-form-urlencoded' ) {
499 $c->prepare_parameters;
501 elsif ( $c->req->content_type eq 'multipart/form-data' ) {
502 $c->prepare_parameters;
510 if ( $c->request->method eq 'GET' ) {
511 $c->prepare_parameters;
514 if ( $c->debug && keys %{ $c->req->params } ) {
515 my $t = Text::ASCIITable->new;
516 $t->setCols( 'Key', 'Value' );
517 $t->setColWidth( 'Key', 37, 1 );
518 $t->setColWidth( 'Value', 36, 1 );
519 for my $key ( sort keys %{ $c->req->params } ) {
520 my $param = $c->req->params->{$key};
521 my $value = defined($param) ? $param : '';
522 $t->addRow( $key, $value );
524 $c->log->debug( 'Parameters are', $t->draw );
530 =item $c->prepare_action
538 my $path = $c->req->path;
539 my @path = split /\//, $c->req->path;
540 $c->req->args( \my @args );
543 $path = join '/', @path;
544 if ( my $result = ${ $c->get_action($path) }[0] ) {
548 my $match = $result->[1];
549 my @snippets = @{ $result->[2] };
551 qq/Requested action is "$path" and matched "$match"/)
554 'Snippets are "' . join( ' ', @snippets ) . '"' )
555 if ( $c->debug && @snippets );
556 $c->req->action($match);
557 $c->req->snippets( \@snippets );
561 $c->req->action($path);
562 $c->log->debug(qq/Requested action is "$path"/) if $c->debug;
565 $c->req->match($path);
568 unshift @args, pop @path;
571 unless ( $c->req->action ) {
572 $c->req->action('default');
576 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
577 if ( $c->debug && @args );
580 =item $c->prepare_body
582 Prepare message body.
588 =item $c->prepare_connection
594 sub prepare_connection { }
596 =item $c->prepare_cookies
602 sub prepare_cookies {
605 if ( my $header = $c->request->header('Cookie') ) {
606 $c->req->cookies( { CGI::Cookie->parse($header) } );
610 =item $c->prepare_headers
616 sub prepare_headers { }
618 =item $c->prepare_parameters
624 sub prepare_parameters { }
626 =item $c->prepare_path
628 Prepare path and base.
634 =item $c->prepare_request
636 Prepare the engine request.
640 sub prepare_request { }
642 =item $c->prepare_uploads
648 sub prepare_uploads { }
662 Returns a C<Catalyst::Request> object.
670 Returns a C<Catalyst::Response> object.
685 # Initialize our data structure
686 $self->components( {} );
688 $self->setup_components;
690 if ( $self->debug ) {
691 my $t = Text::ASCIITable->new;
692 $t->setOptions( 'hide_HeadRow', 1 );
693 $t->setOptions( 'hide_HeadLine', 1 );
694 $t->setCols('Class');
695 $t->setColWidth( 'Class', 75, 1 );
696 $t->addRow($_) for sort keys %{ $self->components };
697 $self->log->debug( 'Loaded components', $t->draw )
698 if ( @{ $t->{tbl_rows} } );
701 # Add our self to components, since we are also a component
702 $self->components->{$self} = $self;
704 $self->setup_actions;
706 if ( $self->debug ) {
707 my $name = $self->config->{name} || 'Application';
708 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
712 =item $class->setup_components
718 sub setup_components {
722 my ( $component, $context ) = @_;
724 unless ( $component->isa('Catalyst::Base') ) {
728 my $suffix = Catalyst::Utils::class2classsuffix($component);
729 my $config = $self->config->{$suffix} || {};
733 eval { $instance = $component->new( $context, $config ); };
735 if ( my $error = $@ ) {
739 Catalyst::Exception->throw(
740 message => qq/Couldn't instantiate component "$component", "$error"/
748 Module::Pluggable::Fast->import(
749 name => '_components',
751 "$self\::Controller", "$self\::C",
752 "$self\::Model", "$self\::M",
753 "$self\::View", "$self\::V"
755 callback => $callback
759 if ( my $error = $@ ) {
763 Catalyst::Exception->throw(
764 message => qq/Couldn't load components "$error"/
768 for my $component ( $self->_components($self) ) {
769 $self->components->{ ref $component || $component } = $component;
775 Contains the return value of the last executed action.
779 Returns a hashref containing all your data.
781 $c->stash->{foo} ||= 'yada';
782 print $c->stash->{foo};
789 my $stash = @_ > 1 ? {@_} : $_[0];
790 while ( my ( $key, $val ) = each %$stash ) {
791 $self->{stash}->{$key} = $val;
794 return $self->{stash};
801 Sebastian Riedel, C<sri@cpan.org>
805 This program is free software, you can redistribute it and/or modify it under
806 the same terms as Perl itself.