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 for my $regex ( keys %{ $self->actions->{compiled} } ) {
98 my $name = $self->actions->{compiled}->{$regex};
99 if ( $action =~ $regex ) {
101 for my $i ( 1 .. 9 ) {
104 push @snippets, ${$i};
106 return [ $self->actions->{regex}->{$name},
115 keys %{ $self->actions->{plain} },
116 keys %{ $self->actions->{regex} }
123 Takes a coderef with arguments and returns elapsed time as float.
125 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
126 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
133 my $time = [gettimeofday];
134 my @return = &$code(@_);
135 my $elapsed = tv_interval $time;
136 return wantarray ? ( $elapsed, @return ) : $elapsed;
139 =head3 component (comp)
141 Get a component object by name.
143 $c->comp('MyApp::Model::MyModel')->do_stuff;
145 Regex search for a component.
147 $c->comp('mymodel')->do_stuff;
152 my ( $c, $name ) = @_;
153 if ( my $component = $c->components->{$name} ) {
157 for my $component ( keys %{ $c->components } ) {
158 return $c->components->{$component} if $component =~ /$name/i;
165 Returns an arrayref containing errors messages.
167 my @errors = @{ $c->errors };
171 $c->errors('Something bad happened');
177 my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
178 push @{ $c->{errors} }, @$errors;
190 if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
191 $c->res->headers->content_type('text/html');
192 my $name = $c->config->{name} || 'Catalyst Application';
193 my ( $title, $errors, $infos );
195 $errors = join '<br/>', @{ $c->errors };
196 $errors ||= 'No output';
197 $title = $name = "$name on Catalyst $Catalyst::VERSION";
198 my $req = encode_entities Dumper $c->req;
199 my $res = encode_entities Dumper $c->res;
200 my $stash = encode_entities Dumper $c->stash;
203 <b><u>Request</u></b><br/>
205 <b><u>Response</u></b><br/>
207 <b><u>Stash</u></b><br/>
216 (en) Please come back later
217 (de) Bitte versuchen sie es spaeter nocheinmal
218 (nl) Gelieve te komen later terug
219 (no) Vennligst prov igjen senere
220 (fr) Veuillez revenir plus tard
221 (es) Vuelto por favor mas adelante
222 (pt) Voltado por favor mais tarde
223 (it) Ritornato prego piĆ¹ successivamente
228 $c->res->{output} = <<"";
231 <title>$title</title>
232 <style type="text/css">
234 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
235 Tahoma, Arial, helvetica, sans-serif;
237 background-color: #eee;
242 background-color: #ccc;
243 border: 1px solid #aaa;
246 -moz-border-radius: 10px;
249 background-color: #977;
250 border: 1px solid #755;
254 -moz-border-radius: 10px;
257 background-color: #797;
258 border: 1px solid #575;
262 -moz-border-radius: 10px;
265 background-color: #779;
266 border: 1px solid #557;
269 -moz-border-radius: 10px;
275 <div class="errors">$errors</div>
276 <div class="infos">$infos</div>
277 <div class="name">$name</div>
283 if ( my $location = $c->res->redirect ) {
284 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
285 $c->res->headers->header( Location => $location );
286 $c->res->status(302);
288 $c->res->headers->content_length( length $c->res->output );
289 my $status = $c->finalize_headers;
294 =head3 finalize_headers
300 sub finalize_headers { }
302 =head3 finalize_output
308 sub finalize_output { }
312 Forward processing to a private/public action or a method from a class.
313 If you define a class without method it will default to process().
316 $c->forward('index.html');
317 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
318 $c->forward('MyApp::View::TT');
326 $c->log->debug('Nothing to forward to') if $c->debug;
329 if ( $command =~ /^\?(.*)$/ ) {
331 my $caller = caller(0);
332 $command = _prefix( $caller, $command );
334 elsif ( $command =~ /^\!\?(.*)$/ ) {
336 my $caller = caller(0);
337 $command = _prefix( $caller, $command );
338 $command = "\!$command";
340 elsif ( $command =~ /^\!(.*)$/ ) {
342 my $caller = caller(0);
343 my $prefix = _class2prefix($caller);
344 $try = "!$prefix/$command";
345 $command = $try if $c->actions->{plain}->{$try};
347 my ( $class, $code );
348 if ( my $action = $c->action($command) ) {
349 if ( $action->[2] ) {
350 $c->log->debug(qq/Couldn't forward "$command" to regex action/)
354 ( $class, $code ) = @{ $action->[0] };
358 if ( $class =~ /[^\w\:]/ ) {
359 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
362 my $method = shift || 'process';
363 if ( $code = $class->can($method) ) {
364 $c->actions->{reverse}->{"$code"} = "$class->$method";
367 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
372 $class = $c->components->{$class} || $class;
373 return $c->process( $class, $code );
383 my ( $class, $r ) = @_;
385 # Always expect worst case!
389 my $c = $class->prepare($r);
390 if ( my $action = $c->action( $c->req->action ) ) {
392 my $class = ${ $action->[0] }[0];
393 my $prefix = _class2prefix($class);
395 if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
396 $begin = "\!$prefix/begin";
398 elsif ( $c->actions->{plain}->{'!begin'} ) {
401 if ( $c->actions->{plain}->{"\!$prefix/end"} ) {
402 $end = "\!$prefix/end";
404 elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
407 if ( $c->actions->{plain}->{'!begin'} ) {
410 if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
412 $c->forward($begin) if $begin;
413 $c->forward( $c->req->action ) if $c->req->action;
414 $c->forward($end) if $end;
417 my $action = $c->req->path;
419 ? qq/Unknown resource "$action"/
420 : "No default action defined";
421 $c->log->error($error) if $c->debug;
426 if ( $class->debug ) {
428 ( $elapsed, $status ) = $class->benchmark($handler);
429 $elapsed = sprintf '%f', $elapsed;
430 my $av = sprintf '%.3f', 1 / $elapsed;
431 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
433 else { $status = &$handler }
435 if ( my $error = $@ ) {
437 $class->log->error(qq/Caught exception in engine "$error"/);
445 Turns the request (Apache, CGI...) into a Catalyst context.
450 my ( $class, $r ) = @_;
452 request => Catalyst::Request->new(
456 headers => HTTP::Headers->new,
462 response => Catalyst::Response->new(
463 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
468 my $secs = time - $START || 1;
469 my $av = sprintf '%.3f', $COUNT / $secs;
470 $c->log->debug('********************************');
471 $c->log->debug("* Request $COUNT ($av/s) [$$]");
472 $c->log->debug('********************************');
473 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
475 $c->prepare_request($r);
479 my $method = $c->req->method;
480 my $path = $c->req->path;
481 $c->log->debug(qq/"$method" request for "$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);
522 unshift @args, pop @path;
524 unless ( $c->req->action ) {
525 my $prefix = $c->req->args->[0];
526 if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) {
528 $c->req->action("\!$prefix/default");
529 $c->log->debug('Using prefixed default action') if $c->debug;
531 elsif ( $c->actions->{plain}->{'!default'} ) {
533 $c->req->action('!default');
534 $c->log->debug('Using default action') if $c->debug;
537 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
538 if ( $c->debug && @args );
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.