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;
485 if ( $c->debug && keys %{ $c->req->params } ) {
487 for my $key ( keys %{ $c->req->params } ) {
488 my $value = $c->req->params->{$key};
489 push @params, "$key=$value";
491 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
497 =head3 prepare_action
505 my $path = $c->req->path;
506 my @path = split /\//, $c->req->path;
507 $c->req->args( \my @args );
509 $path = join '/', @path;
510 if ( my $result = $c->action($path) ) {
514 my $match = $result->[1];
515 my @snippets = @{ $result->[2] };
516 $c->log->debug(qq/Requested action "$path" matched "$match"/)
519 'Snippets are "' . join( ' ', @snippets ) . '"' )
520 if ( $c->debug && @snippets );
521 $c->req->action($match);
522 $c->req->snippets( \@snippets );
525 $c->req->action($path);
526 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
528 $c->req->match($path);
531 unshift @args, pop @path;
533 unless ( $c->req->action ) {
534 my $prefix = $c->req->args->[0];
535 if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) {
537 $c->req->action("\!$prefix/default");
538 $c->log->debug('Using prefixed default action') if $c->debug;
540 elsif ( $c->actions->{plain}->{'!default'} ) {
542 $c->req->action('!default');
543 $c->log->debug('Using default action') if $c->debug;
546 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
547 if ( $c->debug && @args );
550 =head3 prepare_cookies;
556 sub prepare_cookies { }
558 =head3 prepare_headers
564 sub prepare_headers { }
566 =head3 prepare_parameters
572 sub prepare_parameters { }
576 Prepare path and base.
582 =head3 prepare_request
584 Prepare the engine request.
588 sub prepare_request { }
590 =head3 prepare_uploads
596 sub prepare_uploads { }
600 Process a coderef in given class and catch exceptions.
601 Errors are available via $c->errors.
606 my ( $c, $class, $code ) = @_;
611 my $action = $c->actions->{reverse}->{"$code"} || "$code";
613 ( $elapsed, $status ) =
614 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
615 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
618 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
620 if ( my $error = $@ ) {
622 $error = qq/Caught exception "$error"/;
623 $c->log->error($error);
624 $c->errors($error) if $c->debug;
634 $c->remove_action('!foo');
639 my ( $self, $action ) = @_;
640 if ( delete $self->actions->{regex}->{$action} ) {
641 while ( my ( $regex, $name ) = each %{ $self->actions->{compiled} } ) {
642 if ( $name eq $action ) {
643 delete $self->actions->{compiled}->{$regex};
649 delete $self->actions->{plain}->{$action};
655 Returns a C<Catalyst::Request> object.
659 =head3 response (res)
661 Returns a C<Catalyst::Response> object.
675 $self->setup_components;
676 if ( $self->debug ) {
677 my $name = $self->config->{name} || 'Application';
678 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
682 =head3 setup_components
688 sub setup_components {
692 my $class = ref $self || $self;
695 import Module::Pluggable::Fast
696 name => '_components',
698 '$class\::Controller', '$class\::C',
699 '$class\::Model', '$class\::M',
700 '$class\::View', '$class\::V'
703 if ( my $error = $@ ) {
706 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
708 $self->components( {} );
709 for my $component ( $self->_components($self) ) {
710 $self->components->{ ref $component } = $component;
712 $self->log->debug( 'Initialized components "'
713 . join( ' ', keys %{ $self->components } )
720 Returns a hashref containing all your data.
722 $c->stash->{foo} ||= 'yada';
723 print $c->stash->{foo};
730 my $stash = $_[1] ? {@_} : $_[0];
731 while ( my ( $key, $val ) = each %$stash ) {
732 $self->{stash}->{$key} = $val;
735 return $self->{stash};
739 my ( $class, $name ) = @_;
740 my $prefix = _class2prefix($class);
741 $name = "$prefix/$name" if $prefix;
747 $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
748 my $prefix = lc $1 || '';
749 $prefix =~ s/\:\:/_/g;
755 Sebastian Riedel, C<sri@cpan.org>
759 This program is free software, you can redistribute it and/or modify it under
760 the same terms as Perl itself.