1 package Catalyst::Engine;
4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
5 use UNIVERSAL::require;
9 use Time::HiRes qw/gettimeofday tv_interval/;
10 use Catalyst::Request;
11 use Catalyst::Response;
13 require Module::Pluggable::Fast;
15 $Data::Dumper::Terse = 1;
17 __PACKAGE__->mk_classdata($_) for qw/actions components/;
18 __PACKAGE__->mk_accessors(qw/request response/);
21 { plain => {}, regex => {}, compiled => {}, reverse => {} } );
32 Catalyst::Engine - The Catalyst Engine
44 Add one or more actions.
46 $c->action( '!foo' => sub { $_[1]->res->output('Foo!') } );
48 Get an action's class and coderef.
50 my ($class, $code) = @{ $c->action('foo') };
52 Get a list of available actions.
54 my @actions = $c->action;
56 It also automatically calls setup() if needed.
58 See L<Catalyst::Manual::Intro> for more informations about actions.
64 $self->setup unless $self->components;
65 $self->actions( {} ) unless $self->actions;
67 $_[1] ? ( $action = {@_} ) : ( $action = shift );
68 if ( ref $action eq 'HASH' ) {
69 while ( my ( $name, $code ) = each %$action ) {
70 my $class = caller(0);
71 if ( $name =~ /^\/(.*)\/$/ ) {
73 $self->actions->{compiled}->{qr/$regex/} = $name;
74 $self->actions->{regex}->{$name} = [ $class, $code ];
76 elsif ( $name =~ /^\?(.*)$/ ) {
78 $name = _prefix( $class, $name );
79 $self->actions->{plain}->{$name} = [ $class, $code ];
81 elsif ( $name =~ /^\!\?(.*)$/ ) {
83 $name = _prefix( $class, $name );
85 $self->actions->{plain}->{$name} = [ $class, $code ];
87 else { $self->actions->{plain}->{$name} = [ $class, $code ] }
88 $self->actions->{reverse}->{"$code"} = $name;
89 $self->log->debug(qq/"$class" defined "$name" as "$code"/)
94 if ( my $p = $self->actions->{plain}->{$action} ) { return [$p] }
95 elsif ( my $r = $self->actions->{regex}->{$action} ) { return [$r] }
97 while ( my ( $regex, $name ) =
98 each %{ $self->actions->{compiled} } )
100 if ( $action =~ $regex ) {
102 for my $i ( 1 .. 9 ) {
105 push @snippets, ${$i};
107 return [ $self->actions->{regex}->{$name},
116 keys %{ $self->actions->{plain} },
117 keys %{ $self->actions->{regex} }
124 Takes a coderef with arguments and returns elapsed time as float.
126 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
127 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
134 my $time = [gettimeofday];
135 my @return = &$code(@_);
136 my $elapsed = tv_interval $time;
137 return wantarray ? ( $elapsed, @return ) : $elapsed;
140 =head3 component (comp)
142 Get a component object by name.
144 $c->comp('MyApp::Model::MyModel')->do_stuff;
146 Regex search for a component.
148 $c->comp('mymodel')->do_stuff;
153 my ( $c, $name ) = @_;
154 if ( my $component = $c->components->{$name} ) {
158 for my $component ( keys %{ $c->components } ) {
159 return $c->components->{$component} if $component =~ /$name/i;
166 Returns an arrayref containing errors messages.
168 my @errors = @{ $c->errors };
172 $c->errors('Something bad happened');
178 my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
179 push @{ $c->{errors} }, @$errors;
191 if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
192 $c->res->headers->content_type('text/html');
193 my $name = $c->config->{name} || 'Catalyst Application';
194 my ( $title, $errors, $infos );
196 $errors = join '<br/>', @{ $c->errors };
197 $errors ||= 'No output';
198 $title = $name = "$name on Catalyst $Catalyst::VERSION";
199 my $req = encode_entities Dumper $c->req;
200 my $res = encode_entities Dumper $c->res;
201 my $stash = encode_entities Dumper $c->stash;
204 <b><u>Request</u></b><br/>
206 <b><u>Response</u></b><br/>
208 <b><u>Stash</u></b><br/>
217 (en) Please come back later
218 (de) Bitte versuchen sie es spaeter nocheinmal
219 (nl) Gelieve te komen later terug
220 (no) Vennligst prov igjen senere
221 (fr) Veuillez revenir plus tard
222 (es) Vuelto por favor mas adelante
223 (pt) Voltado por favor mais tarde
224 (it) Ritornato prego piĆ¹ successivamente
229 $c->res->{output} = <<"";
232 <title>$title</title>
233 <style type="text/css">
235 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
236 Tahoma, Arial, helvetica, sans-serif;
238 background-color: #eee;
243 background-color: #ccc;
244 border: 1px solid #aaa;
247 -moz-border-radius: 10px;
250 background-color: #977;
251 border: 1px solid #755;
255 -moz-border-radius: 10px;
258 background-color: #797;
259 border: 1px solid #575;
263 -moz-border-radius: 10px;
266 background-color: #779;
267 border: 1px solid #557;
270 -moz-border-radius: 10px;
276 <div class="errors">$errors</div>
277 <div class="infos">$infos</div>
278 <div class="name">$name</div>
284 if ( my $location = $c->res->redirect ) {
285 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
286 $c->res->headers->header( Location => $location );
287 $c->res->status(302);
289 $c->res->headers->content_length( length $c->res->output );
290 my $status = $c->finalize_headers;
295 =head3 finalize_headers
301 sub finalize_headers { }
303 =head3 finalize_output
309 sub finalize_output { }
313 Forward processing to a private/public action or a method from a class.
314 If you define a class without method it will default to process().
317 $c->forward('index.html');
318 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
319 $c->forward('MyApp::View::TT');
327 $c->log->debug('Nothing to forward to') if $c->debug;
330 if ( $command =~ /^\?(.*)$/ ) {
332 my $caller = caller(0);
333 $command = _prefix( $caller, $command );
335 elsif ( $command =~ /^\!\?(.*)$/ ) {
337 my $caller = caller(0);
338 $command = _prefix( $caller, $command );
339 $command = "\!$command";
341 elsif ( $command =~ /^\!(.*)$/ ) {
343 my $caller = caller(0);
344 my $prefix = _class2prefix($caller);
345 $try = "!$prefix/$command";
346 $command = $try if $c->actions->{plain}->{$try};
348 my ( $class, $code );
349 if ( my $action = $c->action($command) ) {
350 if ( $action->[2] ) {
351 $c->log->debug(qq/Couldn't forward "$command" to regex action/)
355 ( $class, $code ) = @{ $action->[0] };
359 if ( $class =~ /[^\w\:]/ ) {
360 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
363 my $method = shift || 'process';
364 if ( $code = $class->can($method) ) {
365 $c->actions->{reverse}->{"$code"} = "$class->$method";
368 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
373 $class = $c->components->{$class} || $class;
374 return $c->process( $class, $code );
384 my ( $class, $r ) = @_;
386 # Always expect worst case!
390 my $c = $class->prepare($r);
391 if ( my $action = $c->action( $c->req->action ) ) {
393 my $class = ${ $action->[0] }[0];
394 my $prefix = _class2prefix($class);
396 if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
397 $begin = "\!$prefix/begin";
399 elsif ( $c->actions->{plain}->{'!begin'} ) {
402 if ( $c->actions->{plain}->{"\!$prefix/end"} ) {
403 $end = "\!$prefix/end";
405 elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
408 if ( $c->actions->{plain}->{'!begin'} ) {
411 if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
413 $c->forward($begin) if $begin;
414 $c->forward( $c->req->action ) if $c->req->action;
415 $c->forward($end) if $end;
418 my $action = $c->req->path;
420 ? qq/Unknown resource "$action"/
421 : "No default action defined";
422 $c->log->error($error) if $c->debug;
427 if ( $class->debug ) {
429 ( $elapsed, $status ) = $class->benchmark($handler);
430 $elapsed = sprintf '%f', $elapsed;
431 my $av = sprintf '%.3f', 1 / $elapsed;
432 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
434 else { $status = &$handler }
436 if ( my $error = $@ ) {
438 $class->log->error(qq/Caught exception in engine "$error"/);
446 Turns the request (Apache, CGI...) into a Catalyst context.
451 my ( $class, $r ) = @_;
453 request => Catalyst::Request->new(
457 headers => HTTP::Headers->new,
463 response => Catalyst::Response->new(
464 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
469 my $secs = time - $START || 1;
470 my $av = sprintf '%.3f', $COUNT / $secs;
471 $c->log->debug('********************************');
472 $c->log->debug("* Request $COUNT ($av/s) [$$]");
473 $c->log->debug('********************************');
474 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
476 $c->prepare_request($r);
478 my $path = $c->request->path;
479 $c->log->debug(qq/Requested path "$path"/) if $c->debug;
483 $c->prepare_parameters;
488 =head3 prepare_action
496 my $path = $c->req->path;
497 my @path = split /\//, $c->req->path;
498 $c->req->args( \my @args );
500 $path = join '/', @path;
501 if ( my $result = $c->action($path) ) {
505 my $match = $result->[1];
506 my @snippets = @{ $result->[2] };
507 $c->log->debug(qq/Requested action "$path" matched "$match"/)
510 'Snippets are "' . join( ' ', @snippets ) . '"' )
511 if ( $c->debug && @snippets );
512 $c->req->action($match);
513 $c->req->snippets( \@snippets );
516 $c->req->action($path);
517 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
519 $c->req->match($path);
520 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
521 if ( $c->debug && @args );
524 unshift @args, pop @path;
526 unless ( $c->req->action ) {
527 my $prefix = $c->req->args->[0];
528 if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) {
530 $c->req->action("\!$prefix/default");
531 $c->log->debug('Using prefixed default action') if $c->debug;
533 elsif ( $c->actions->{plain}->{'!default'} ) {
535 $c->req->action('!default');
536 $c->log->debug('Using default action') if $c->debug;
541 =head3 prepare_cookies;
547 sub prepare_cookies { }
549 =head3 prepare_headers
555 sub prepare_headers { }
557 =head3 prepare_parameters
563 sub prepare_parameters { }
567 Prepare path and base.
573 =head3 prepare_request
575 Prepare the engine request.
579 sub prepare_request { }
581 =head3 prepare_uploads
587 sub prepare_uploads { }
591 Process a coderef in given class and catch exceptions.
592 Errors are available via $c->errors.
597 my ( $c, $class, $code ) = @_;
602 my $action = $c->actions->{reverse}->{"$code"} || "$code";
604 ( $elapsed, $status ) =
605 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
606 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
609 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
611 if ( my $error = $@ ) {
613 $error = qq/Caught exception "$error"/;
614 $c->log->error($error);
615 $c->errors($error) if $c->debug;
625 $c->remove_action('!foo');
630 my ( $self, $action ) = @_;
631 if ( delete $self->actions->{regex}->{$action} ) {
632 while ( my ( $regex, $name ) = each %{ $self->actions->{compiled} } ) {
633 if ( $name eq $action ) {
634 delete $self->actions->{compiled}->{$regex};
640 delete $self->actions->{plain}->{$action};
646 Returns a C<Catalyst::Request> object.
650 =head3 response (res)
652 Returns a C<Catalyst::Response> object.
666 $self->setup_components;
667 if ( $self->debug ) {
668 my $name = $self->config->{name} || 'Application';
669 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
673 =head3 setup_components
679 sub setup_components {
683 my $class = ref $self || $self;
686 import Module::Pluggable::Fast
687 name => '_components',
689 '$class\::Controller', '$class\::C',
690 '$class\::Model', '$class\::M',
691 '$class\::View', '$class\::V'
694 if ( my $error = $@ ) {
697 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
699 $self->components( {} );
700 for my $component ( $self->_components($self) ) {
701 $self->components->{ ref $component } = $component;
703 $self->log->debug( 'Initialized components "'
704 . join( ' ', keys %{ $self->components } )
711 Returns a hashref containing all your data.
713 $c->stash->{foo} ||= 'yada';
714 print $c->stash->{foo};
721 my $stash = $_[1] ? {@_} : $_[0];
722 while ( my ( $key, $val ) = each %$stash ) {
723 $self->{stash}->{$key} = $val;
726 return $self->{stash};
730 my ( $class, $name ) = @_;
731 my $prefix = _class2prefix($class);
732 $name = "$prefix/$name" if $prefix;
738 $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
739 my $prefix = lc $1 || '';
740 $prefix =~ s/\:\:/_/g;
746 Sebastian Riedel, C<sri@cpan.org>
750 This program is free software, you can redistribute it and/or modify it under
751 the same terms as Perl itself.