1 package Catalyst::Engine;
4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
5 use UNIVERSAL::require;
10 use Time::HiRes qw/gettimeofday tv_interval/;
12 use Tree::Simple::Visitor::FindByPath;
13 use Catalyst::Request;
14 use Catalyst::Response;
16 require Module::Pluggable::Fast;
18 $Data::Dumper::Terse = 1;
20 __PACKAGE__->mk_classdata($_) for qw/actions components tree/;
21 __PACKAGE__->mk_accessors(qw/request response state/);
24 { plain => {}, private => {}, regex => {}, compiled => {}, reverse => {} }
26 __PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
35 memoize('_class2prefix');
39 Catalyst::Engine - The Catalyst Engine
51 =item $c->action( $name => $coderef, ... )
53 Add one or more actions.
55 $c->action( '!foo' => sub { $_[1]->res->output('Foo!') } );
57 It also automatically calls setup() if needed.
59 See L<Catalyst::Manual::Intro> for more informations about actions.
65 $self->setup unless $self->components;
66 $self->actions( {} ) unless $self->actions;
68 $_[1] ? ( $action = {@_} ) : ( $action = shift );
69 if ( ref $action eq 'HASH' ) {
70 while ( my ( $name, $code ) = each %$action ) {
72 my $class = caller(0);
73 if ( $name =~ /^\?(.*)$/ ) {
74 my $prefix = $1 || '';
76 $name = $prefix . _prefix( $class, $name );
77 $self->actions->{plain}->{$name} = [ $class, $code ];
79 if ( $name =~ /^\/(.*)\/$/ ) {
81 $self->actions->{compiled}->{qr#$regex#} = $name;
82 $self->actions->{regex}->{$name} = [ $class, $code ];
84 elsif ( $name =~ /^\!(.*)$/ ) {
86 my $parent = $self->tree;
87 my $visitor = Tree::Simple::Visitor::FindByPath->new;
88 $prefix = _class2prefix($class);
89 for my $part ( split '/', $prefix ) {
90 $visitor->setSearchPath($part);
91 $parent->accept($visitor);
92 my $child = $visitor->getResult;
94 $child = $parent->addChild( Tree::Simple->new($part) );
95 $visitor->setSearchPath($part);
96 $parent->accept($visitor);
97 $child = $visitor->getResult;
101 my $uid = $parent->getUID;
102 $self->actions->{private}->{$uid}->{$name} = [ $class, $code ];
105 else { $self->actions->{plain}->{$name} = [ $class, $code ] }
106 my $reverse = $prefix ? "$name ($prefix)" : $name;
107 $self->actions->{reverse}->{"$code"} = $reverse;
108 $self->log->debug(qq/"$class" defined "$name" as "$code"/)
115 =item $c->find_action( $name, $namespace )
117 Find an action in a given namespace.
122 my ( $c, $action, $namespace ) = @_;
124 if ( $action =~ /^\!(.*)/ ) {
126 my $parent = $c->tree;
128 my $result = $c->actions->{private}->{ $parent->getUID }->{$action};
129 push @results, [$result] if $result;
130 my $visitor = Tree::Simple::Visitor::FindByPath->new;
131 for my $part ( split '/', $namespace ) {
132 $visitor->setSearchPath($part);
133 $parent->accept($visitor);
134 my $child = $visitor->getResult;
135 my $uid = $child->getUID if $child;
136 my $match = $c->actions->{private}->{$uid}->{$action} if $uid;
137 push @results, [$match] if $match;
138 $parent = $child if $child;
142 elsif ( my $p = $c->actions->{plain}->{$action} ) { return [ [$p] ] }
143 elsif ( my $r = $c->actions->{regex}->{$action} ) { return [ [$r] ] }
145 for my $regex ( keys %{ $c->actions->{compiled} } ) {
146 my $name = $c->actions->{compiled}->{$regex};
147 if ( $action =~ $regex ) {
149 for my $i ( 1 .. 9 ) {
152 push @snippets, ${$i};
154 return [ [ $c->actions->{regex}->{$name}, $name, \@snippets ] ];
161 =item $c->benchmark($coderef)
163 Takes a coderef with arguments and returns elapsed time as float.
165 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
166 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
173 my $time = [gettimeofday];
174 my @return = &$code(@_);
175 my $elapsed = tv_interval $time;
176 return wantarray ? ( $elapsed, @return ) : $elapsed;
179 =item $c->comp($name)
181 =item $c->component($name)
183 Get a component object by name.
185 $c->comp('MyApp::Model::MyModel')->do_stuff;
187 Regex search for a component.
189 $c->comp('mymodel')->do_stuff;
194 my ( $c, $name ) = @_;
195 if ( my $component = $c->components->{$name} ) {
199 for my $component ( keys %{ $c->components } ) {
200 return $c->components->{$component} if $component =~ /$name/i;
207 =item $c->errors($error, ...)
209 =item $c->errors($arrayref)
211 Returns an arrayref containing errors messages.
213 my @errors = @{ $c->errors };
217 $c->errors('Something bad happened');
223 my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
224 push @{ $c->{errors} }, @$errors;
237 if ( my $location = $c->res->redirect ) {
238 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
239 $c->res->headers->header( Location => $location );
240 $c->res->status(302);
243 if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
244 $c->res->headers->content_type('text/html');
245 my $name = $c->config->{name} || 'Catalyst Application';
246 my ( $title, $errors, $infos );
248 $errors = join '<br/>', @{ $c->errors };
249 $errors ||= 'No output';
250 $title = $name = "$name on Catalyst $Catalyst::VERSION";
251 my $req = encode_entities Dumper $c->req;
252 my $res = encode_entities Dumper $c->res;
253 my $stash = encode_entities Dumper $c->stash;
256 <b><u>Request</u></b><br/>
258 <b><u>Response</u></b><br/>
260 <b><u>Stash</u></b><br/>
269 (en) Please come back later
270 (de) Bitte versuchen sie es spaeter nocheinmal
271 (nl) Gelieve te komen later terug
272 (no) Vennligst prov igjen senere
273 (fr) Veuillez revenir plus tard
274 (es) Vuelto por favor mas adelante
275 (pt) Voltado por favor mais tarde
276 (it) Ritornato prego piĆ¹ successivamente
281 $c->res->{output} = <<"";
284 <title>$title</title>
285 <style type="text/css">
287 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
288 Tahoma, Arial, helvetica, sans-serif;
290 background-color: #eee;
295 background-color: #ccc;
296 border: 1px solid #aaa;
299 -moz-border-radius: 10px;
302 background-color: #977;
303 border: 1px solid #755;
307 -moz-border-radius: 10px;
310 background-color: #797;
311 border: 1px solid #575;
315 -moz-border-radius: 10px;
318 background-color: #779;
319 border: 1px solid #557;
322 -moz-border-radius: 10px;
328 <div class="errors">$errors</div>
329 <div class="infos">$infos</div>
330 <div class="name">$name</div>
336 $c->res->headers->content_length( length $c->res->output );
337 my $status = $c->finalize_headers;
342 =item $c->finalize_headers
348 sub finalize_headers { }
350 =item $c->finalize_output
356 sub finalize_output { }
358 =item $c->forward($command)
360 Forward processing to a private/public action or a method from a class.
361 If you define a class without method it will default to process().
364 $c->forward('index.html');
365 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
366 $c->forward('MyApp::View::TT');
374 $c->log->debug('Nothing to forward to') if $c->debug;
377 my $caller = caller(0);
378 if ( $command =~ /^\?(.*)$/ ) {
380 $command = _prefix( $caller, $command );
383 if ( $command =~ /^\!/ ) {
384 $namespace = _class2prefix($caller);
386 if ( my $results = $c->find_action( $command, $namespace ) ) {
387 if ( $command =~ /^\!/ ) {
388 for my $result ( @{$results} ) {
389 my ( $class, $code ) = @{ $result->[0] };
390 $c->state( $c->process( $class, $code ) );
394 return 0 unless my $result = $results->[0];
395 if ( $result->[2] ) {
396 $c->log->debug(qq/Couldn't forward "$command" to regex action/)
400 my ( $class, $code ) = @{ $result->[0] };
401 $class = $c->components->{$class} || $class;
402 $c->state( $c->process( $class, $code ) );
406 my $class = $command;
407 if ( $class =~ /[^\w\:]/ ) {
408 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
411 my $method = shift || 'process';
412 if ( my $code = $class->can($method) ) {
413 $c->actions->{reverse}->{"$code"} = "$class->$method";
414 $c->state( $c->process( $class, $code ) );
417 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
425 =item $c->handler($r)
432 my ( $class, $r ) = @_;
434 # Always expect worst case!
438 my $c = $class->prepare($r);
439 my $action = $c->req->action;
441 $namespace = join '/', @{ $c->req->args } if $action eq '!default';
442 unless ($namespace) {
443 if ( my $result = $c->find_action($action) ) {
444 $namespace = _class2prefix( $result->[0]->[0]->[0] );
447 my $results = $c->find_action( $action, $namespace );
449 for my $begin ( @{ $c->find_action( '!begin', $namespace ) } ) {
450 $c->process( @{ $begin->[0] } );
452 for my $result ( @{ $c->find_action( $action, $namespace ) } ) {
453 $c->process( @{ $result->[0] } );
455 for my $end ( @{ $c->find_action( '!end', $namespace ) } ) {
456 $c->process( @{ $end->[0] } );
460 my $path = $c->req->path;
462 ? qq/Unknown resource "$path"/
463 : "No default action defined";
464 $c->log->error($error) if $c->debug;
469 if ( $class->debug ) {
471 ( $elapsed, $status ) = $class->benchmark($handler);
472 $elapsed = sprintf '%f', $elapsed;
473 my $av = sprintf '%.3f', 1 / $elapsed;
474 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
476 else { $status = &$handler }
478 if ( my $error = $@ ) {
480 $class->log->error(qq/Caught exception in engine "$error"/);
486 =item $c->prepare($r)
488 Turns the engine-specific request (Apache, CGI...) into a Catalyst context.
493 my ( $class, $r ) = @_;
495 request => Catalyst::Request->new(
499 headers => HTTP::Headers->new,
505 response => Catalyst::Response->new(
506 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
512 my $secs = time - $START || 1;
513 my $av = sprintf '%.3f', $COUNT / $secs;
514 $c->log->debug('********************************');
515 $c->log->debug("* Request $COUNT ($av/s) [$$]");
516 $c->log->debug('********************************');
517 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
519 $c->prepare_request($r);
523 $c->prepare_connection;
524 my $method = $c->req->method || '';
525 my $path = $c->req->path || '';
526 my $hostname = $c->req->hostname || '';
527 my $address = $c->req->address || '';
528 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
531 $c->prepare_parameters;
533 if ( $c->debug && keys %{ $c->req->params } ) {
535 for my $key ( keys %{ $c->req->params } ) {
536 my $value = $c->req->params->{$key} || '';
537 push @params, "$key=$value";
539 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
545 =item $c->prepare_action
553 my $path = $c->req->path;
554 my @path = split /\//, $c->req->path;
555 $c->req->args( \my @args );
557 $path = join '/', @path;
558 if ( my $result = ${ $c->find_action($path) }[0] ) {
562 my $match = $result->[1];
563 my @snippets = @{ $result->[2] };
564 $c->log->debug(qq/Requested action "$path" matched "$match"/)
567 'Snippets are "' . join( ' ', @snippets ) . '"' )
568 if ( $c->debug && @snippets );
569 $c->req->action($match);
570 $c->req->snippets( \@snippets );
573 $c->req->action($path);
574 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
576 $c->req->match($path);
579 unshift @args, pop @path;
581 unless ( $c->req->action ) {
582 $c->req->action('!default');
585 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
586 if ( $c->debug && @args );
589 =item $c->prepare_connection;
595 sub prepare_connection { }
597 =item $c->prepare_cookies;
603 sub prepare_cookies { }
605 =item $c->prepare_headers
611 sub prepare_headers { }
613 =item $c->prepare_parameters
619 sub prepare_parameters { }
621 =item $c->prepare_path
623 Prepare path and base.
629 =item $c->prepare_request
631 Prepare the engine request.
635 sub prepare_request { }
637 =item $c->prepare_uploads
643 sub prepare_uploads { }
645 =item $c->process($class, $coderef)
647 Process a coderef in given class and catch exceptions.
648 Errors are available via $c->errors.
653 my ( $c, $class, $code ) = @_;
658 my $action = $c->actions->{reverse}->{"$code"} || "$code";
660 ( $elapsed, $status ) =
661 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
662 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
665 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
667 if ( my $error = $@ ) {
669 $error = qq/Caught exception "$error"/;
670 $c->log->error($error);
671 $c->errors($error) if $c->debug;
681 Returns a C<Catalyst::Request> object.
689 Returns a C<Catalyst::Response> object.
703 $self->setup_components;
704 if ( $self->debug ) {
705 my $name = $self->config->{name} || 'Application';
706 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
710 =item $class->setup_components
716 sub setup_components {
720 my $class = ref $self || $self;
723 import Module::Pluggable::Fast
724 name => '_components',
726 '$class\::Controller', '$class\::C',
727 '$class\::Model', '$class\::M',
728 '$class\::View', '$class\::V'
731 if ( my $error = $@ ) {
734 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
736 $self->components( {} );
737 for my $component ( $self->_components($self) ) {
738 $self->components->{ ref $component } = $component;
740 $self->log->debug( 'Initialized components "'
741 . join( ' ', keys %{ $self->components } )
748 Returns a hashref containing all your data.
750 $c->stash->{foo} ||= 'yada';
751 print $c->stash->{foo};
758 my $stash = $_[1] ? {@_} : $_[0];
759 while ( my ( $key, $val ) = each %$stash ) {
760 $self->{stash}->{$key} = $val;
763 return $self->{stash};
767 my ( $class, $name ) = @_;
768 my $prefix = _class2prefix($class);
769 $name = "$prefix/$name" if $prefix;
774 my $class = shift || '';
775 $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
776 my $prefix = lc $2 || '';
777 $prefix =~ s/\:\:/\//g;
785 Sebastian Riedel, C<sri@cpan.org>
789 This program is free software, you can redistribute it and/or modify it under
790 the same terms as Perl itself.