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/);
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 ) {
71 my $class = caller(0);
72 if ( $name =~ /^\?(.*)$/ ) {
73 my $prefix = $1 || '';
75 $name = $prefix . _prefix( $class, $name );
76 $self->actions->{plain}->{$name} = [ $class, $code ];
78 if ( $name =~ /^\/(.*)\/$/ ) {
80 $self->actions->{compiled}->{qr#$regex#} = $name;
81 $self->actions->{regex}->{$name} = [ $class, $code ];
83 elsif ( $name =~ /^\!(.*)$/ ) {
85 my $parent = $self->tree;
86 my $visitor = Tree::Simple::Visitor::FindByPath->new;
87 for my $part ( split '/', _class2prefix($class) ) {
88 $visitor->setSearchPath($part);
89 $parent->accept($visitor);
90 my $child = $visitor->getResult;
92 $child = $parent->addChild( Tree::Simple->new($part) );
93 $visitor->setSearchPath($part);
94 $parent->accept($visitor);
95 $child = $visitor->getResult;
99 my $uid = $parent->getUID;
100 $self->actions->{private}->{$uid}->{$name} = [ $class, $code ];
102 else { $self->actions->{plain}->{$name} = [ $class, $code ] }
103 $self->actions->{reverse}->{"$code"} = $name;
104 $self->log->debug(qq/"$class" defined "$name" as "$code"/)
111 =item $c->find_action( $name, $namespace )
113 Find an action in a given namespace.
118 my ( $c, $action, $namespace ) = @_;
120 if ( $action =~ /^\!(.*)/ ) {
122 my $parent = $c->tree;
123 my $result = $c->actions->{private}->{ $parent->getUID }->{$action};
124 my $visitor = Tree::Simple::Visitor::FindByPath->new;
125 for my $part ( split '/', $namespace ) {
126 $visitor->setSearchPath($part);
127 $parent->accept($visitor);
128 my $child = $visitor->getResult;
129 my $uid = $child->getUID if $child;
130 my $match = $c->actions->{private}->{$uid}->{$action} if $uid;
131 $result = $match if $match;
132 $parent = $child if $child;
134 return [$result] if $result;
136 elsif ( my $p = $c->actions->{plain}->{$action} ) { return [$p] }
137 elsif ( my $r = $c->actions->{regex}->{$action} ) { return [$r] }
139 for my $regex ( keys %{ $c->actions->{compiled} } ) {
140 my $name = $c->actions->{compiled}->{$regex};
141 if ( $action =~ $regex ) {
143 for my $i ( 1 .. 9 ) {
146 push @snippets, ${$i};
148 return [ $c->actions->{regex}->{$name}, $name, \@snippets ];
155 =item $c->benchmark($coderef)
157 Takes a coderef with arguments and returns elapsed time as float.
159 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
160 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
167 my $time = [gettimeofday];
168 my @return = &$code(@_);
169 my $elapsed = tv_interval $time;
170 return wantarray ? ( $elapsed, @return ) : $elapsed;
173 =item $c->comp($name)
175 =item $c->component($name)
177 Get a component object by name.
179 $c->comp('MyApp::Model::MyModel')->do_stuff;
181 Regex search for a component.
183 $c->comp('mymodel')->do_stuff;
188 my ( $c, $name ) = @_;
189 if ( my $component = $c->components->{$name} ) {
193 for my $component ( keys %{ $c->components } ) {
194 return $c->components->{$component} if $component =~ /$name/i;
201 =item $c->errors($error, ...)
203 =item $c->errors($arrayref)
205 Returns an arrayref containing errors messages.
207 my @errors = @{ $c->errors };
211 $c->errors('Something bad happened');
217 my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
218 push @{ $c->{errors} }, @$errors;
231 if ( my $location = $c->res->redirect ) {
232 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
233 $c->res->headers->header( Location => $location );
234 $c->res->status(302);
237 if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
238 $c->res->headers->content_type('text/html');
239 my $name = $c->config->{name} || 'Catalyst Application';
240 my ( $title, $errors, $infos );
242 $errors = join '<br/>', @{ $c->errors };
243 $errors ||= 'No output';
244 $title = $name = "$name on Catalyst $Catalyst::VERSION";
245 my $req = encode_entities Dumper $c->req;
246 my $res = encode_entities Dumper $c->res;
247 my $stash = encode_entities Dumper $c->stash;
250 <b><u>Request</u></b><br/>
252 <b><u>Response</u></b><br/>
254 <b><u>Stash</u></b><br/>
263 (en) Please come back later
264 (de) Bitte versuchen sie es spaeter nocheinmal
265 (nl) Gelieve te komen later terug
266 (no) Vennligst prov igjen senere
267 (fr) Veuillez revenir plus tard
268 (es) Vuelto por favor mas adelante
269 (pt) Voltado por favor mais tarde
270 (it) Ritornato prego piĆ¹ successivamente
275 $c->res->{output} = <<"";
278 <title>$title</title>
279 <style type="text/css">
281 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
282 Tahoma, Arial, helvetica, sans-serif;
284 background-color: #eee;
289 background-color: #ccc;
290 border: 1px solid #aaa;
293 -moz-border-radius: 10px;
296 background-color: #977;
297 border: 1px solid #755;
301 -moz-border-radius: 10px;
304 background-color: #797;
305 border: 1px solid #575;
309 -moz-border-radius: 10px;
312 background-color: #779;
313 border: 1px solid #557;
316 -moz-border-radius: 10px;
322 <div class="errors">$errors</div>
323 <div class="infos">$infos</div>
324 <div class="name">$name</div>
330 $c->res->headers->content_length( length $c->res->output );
331 my $status = $c->finalize_headers;
336 =item $c->finalize_headers
342 sub finalize_headers { }
344 =item $c->finalize_output
350 sub finalize_output { }
352 =item $c->forward($command)
354 Forward processing to a private/public action or a method from a class.
355 If you define a class without method it will default to process().
358 $c->forward('index.html');
359 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
360 $c->forward('MyApp::View::TT');
368 $c->log->debug('Nothing to forward to') if $c->debug;
371 my $caller = caller(0);
372 if ( $command =~ /^\?(.*)$/ ) {
374 $command = _prefix( $caller, $command );
377 if ( $command =~ /^\!/ ) {
378 $namespace = _class2prefix($caller);
380 my ( $class, $code );
381 if ( my $action = $c->find_action( $command, $namespace ) ) {
382 if ( $action->[2] ) {
383 $c->log->debug(qq/Couldn't forward "$command" to regex action/)
387 ( $class, $code ) = @{ $action->[0] };
391 if ( $class =~ /[^\w\:]/ ) {
392 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
395 my $method = shift || 'process';
396 if ( $code = $class->can($method) ) {
397 $c->actions->{reverse}->{"$code"} = "$class->$method";
400 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
405 $class = $c->components->{$class} || $class;
406 return $c->process( $class, $code );
409 =item $c->handler($r)
416 my ( $class, $r ) = @_;
418 # Always expect worst case!
422 my $c = $class->prepare($r);
423 my $action = $c->req->action;
425 $namespace = join '/', @{ $c->req->args } if $action eq '!default';
426 unless ($namespace) {
427 if ( my $result = $c->find_action($action) ) {
428 $namespace = _class2prefix( $result->[0]->[0] );
431 if ( my $begin = $c->find_action( '!begin', $namespace ) ) {
432 $c->process( @{ $begin->[0] } );
434 if ( my $default = $c->find_action( '!default', $namespace ) ) {
435 $c->process( @{ $default->[0] } );
438 my $path = $c->req->path;
440 ? qq/Unknown resource "$path"/
441 : "No default action defined";
442 $c->log->error($error) if $c->debug;
445 if ( my $end = $c->find_action( '!end', $namespace ) ) {
446 $c->process( @{ $end->[0] } );
450 if ( $class->debug ) {
452 ( $elapsed, $status ) = $class->benchmark($handler);
453 $elapsed = sprintf '%f', $elapsed;
454 my $av = sprintf '%.3f', 1 / $elapsed;
455 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
457 else { $status = &$handler }
459 if ( my $error = $@ ) {
461 $class->log->error(qq/Caught exception in engine "$error"/);
467 =item $c->prepare($r)
469 Turns the engine-specific request (Apache, CGI...) into a Catalyst context.
474 my ( $class, $r ) = @_;
476 request => Catalyst::Request->new(
480 headers => HTTP::Headers->new,
486 response => Catalyst::Response->new(
487 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
492 my $secs = time - $START || 1;
493 my $av = sprintf '%.3f', $COUNT / $secs;
494 $c->log->debug('********************************');
495 $c->log->debug("* Request $COUNT ($av/s) [$$]");
496 $c->log->debug('********************************');
497 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
499 $c->prepare_request($r);
503 $c->prepare_connection;
504 my $method = $c->req->method || '';
505 my $path = $c->req->path || '';
506 my $hostname = $c->req->hostname || '';
507 my $address = $c->req->address || '';
508 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
511 $c->prepare_parameters;
513 if ( $c->debug && keys %{ $c->req->params } ) {
515 for my $key ( keys %{ $c->req->params } ) {
516 my $value = $c->req->params->{$key} || '';
517 push @params, "$key=$value";
519 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
525 =item $c->prepare_action
533 my $path = $c->req->path;
534 my @path = split /\//, $c->req->path;
535 $c->req->args( \my @args );
537 $path = join '/', @path;
538 if ( my $result = $c->find_action($path) ) {
542 my $match = $result->[1];
543 my @snippets = @{ $result->[2] };
544 $c->log->debug(qq/Requested action "$path" matched "$match"/)
547 'Snippets are "' . join( ' ', @snippets ) . '"' )
548 if ( $c->debug && @snippets );
549 $c->req->action($match);
550 $c->req->snippets( \@snippets );
553 $c->req->action($path);
554 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
556 $c->req->match($path);
559 unshift @args, pop @path;
561 unless ( $c->req->action ) {
562 $c->req->action('!default');
565 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
566 if ( $c->debug && @args );
569 =item $c->prepare_connection;
575 sub prepare_connection { }
577 =item $c->prepare_cookies;
583 sub prepare_cookies { }
585 =item $c->prepare_headers
591 sub prepare_headers { }
593 =item $c->prepare_parameters
599 sub prepare_parameters { }
601 =item $c->prepare_path
603 Prepare path and base.
609 =item $c->prepare_request
611 Prepare the engine request.
615 sub prepare_request { }
617 =item $c->prepare_uploads
623 sub prepare_uploads { }
625 =item $c->process($class, $coderef)
627 Process a coderef in given class and catch exceptions.
628 Errors are available via $c->errors.
633 my ( $c, $class, $code ) = @_;
638 my $action = $c->actions->{reverse}->{"$code"} || "$code";
640 ( $elapsed, $status ) =
641 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
642 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
645 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
647 if ( my $error = $@ ) {
649 $error = qq/Caught exception "$error"/;
650 $c->log->error($error);
651 $c->errors($error) if $c->debug;
661 Returns a C<Catalyst::Request> object.
669 Returns a C<Catalyst::Response> object.
683 $self->setup_components;
684 if ( $self->debug ) {
685 my $name = $self->config->{name} || 'Application';
686 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
690 =item $class->setup_components
696 sub setup_components {
700 my $class = ref $self || $self;
703 import Module::Pluggable::Fast
704 name => '_components',
706 '$class\::Controller', '$class\::C',
707 '$class\::Model', '$class\::M',
708 '$class\::View', '$class\::V'
711 if ( my $error = $@ ) {
714 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
716 $self->components( {} );
717 for my $component ( $self->_components($self) ) {
718 $self->components->{ ref $component } = $component;
720 $self->log->debug( 'Initialized components "'
721 . join( ' ', keys %{ $self->components } )
728 Returns a hashref containing all your data.
730 $c->stash->{foo} ||= 'yada';
731 print $c->stash->{foo};
738 my $stash = $_[1] ? {@_} : $_[0];
739 while ( my ( $key, $val ) = each %$stash ) {
740 $self->{stash}->{$key} = $val;
743 return $self->{stash};
747 my ( $class, $name ) = @_;
748 my $prefix = _class2prefix($class);
749 $name = "$prefix/$name" if $prefix;
755 $class =~ /^.*::([MVC]|Model|View|Controller)+::(.*)$/;
756 my $prefix = lc $2 || '';
757 $prefix =~ s/\:\:/\//g;
765 Sebastian Riedel, C<sri@cpan.org>
769 This program is free software, you can redistribute it and/or modify it under
770 the same terms as Perl itself.