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 [ $name, \@snippets ];
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 ( $class, $code ) = @{ $action->[0] };
353 if ( $class =~ /[^\w\:]/ ) {
354 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
357 my $method = shift || 'process';
358 if ( $code = $class->can($method) ) {
359 $c->actions->{reverse}->{"$code"} = "$class->$method";
362 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
367 $class = $c->components->{$class} || $class;
368 return $c->process( $class, $code );
378 my ( $class, $r ) = @_;
380 # Always expect worst case!
384 my $c = $class->prepare($r);
385 if ( my $action = $c->action( $c->req->action ) ) {
387 my $class = ${ $action->[0] }[0];
388 my $prefix = _class2prefix($class);
390 if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
391 $begin = "\!$prefix/begin";
393 elsif ( $c->actions->{plain}->{'!begin'} ) {
396 if ( $c->actions->{plain}->{"\!$prefix/end"} ) {
397 $end = "\!$prefix/end";
399 elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
402 if ( $c->actions->{plain}->{'!begin'} ) {
405 if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
407 $c->forward($begin) if $begin;
408 $c->forward( $c->req->action ) if $c->req->action;
409 $c->forward($end) if $end;
412 my $action = $c->req->path;
414 ? qq/Unknown resource "$action"/
415 : "No default action defined";
416 $c->log->error($error) if $c->debug;
421 if ( $class->debug ) {
423 ( $elapsed, $status ) = $class->benchmark($handler);
424 $elapsed = sprintf '%f', $elapsed;
425 my $av = sprintf '%.3f', 1 / $elapsed;
426 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
428 else { $status = &$handler }
430 if ( my $error = $@ ) {
432 $class->log->error(qq/Caught exception in engine "$error"/);
440 Turns the request (Apache, CGI...) into a Catalyst context.
445 my ( $class, $r ) = @_;
447 request => Catalyst::Request->new(
451 headers => HTTP::Headers->new,
457 response => Catalyst::Response->new(
458 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
463 my $secs = time - $START || 1;
464 my $av = sprintf '%.3f', $COUNT / $secs;
465 $c->log->debug('********************************');
466 $c->log->debug("* Request $COUNT ($av/s) [$$]");
467 $c->log->debug('********************************');
468 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
470 $c->prepare_request($r);
472 my $path = $c->request->path;
473 $c->log->debug(qq/Requested path "$path"/) if $c->debug;
477 $c->prepare_parameters;
482 =head3 prepare_action
490 my $path = $c->req->path;
491 my @path = split /\//, $c->req->path;
492 $c->req->args( \my @args );
494 $path = join '/', @path;
495 if ( my $result = $c->action($path) ) {
499 my $match = $result->[0];
500 my @snippets = @{ $result->[1] };
501 $c->log->debug(qq/Requested action "$path" matched "$match"/)
504 'Snippets are "' . join( ' ', @snippets ) . '"' )
505 if ( $c->debug && @snippets );
506 $c->req->action($match);
507 $c->req->snippets( \@snippets );
510 $c->req->action($path);
511 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
513 $c->req->match($path);
514 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
515 if ( $c->debug && @args );
518 unshift @args, pop @path;
520 unless ( $c->req->action ) {
521 my $prefix = $c->req->args->[0];
522 if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) {
524 $c->req->action("\!$prefix/default");
525 $c->log->debug('Using prefixed default action') if $c->debug;
527 elsif ( $c->actions->{plain}->{'!default'} ) {
529 $c->req->action('!default');
530 $c->log->debug('Using default action') if $c->debug;
535 =head3 prepare_cookies;
541 sub prepare_cookies { }
543 =head3 prepare_headers
549 sub prepare_headers { }
551 =head3 prepare_parameters
557 sub prepare_parameters { }
561 Prepare path and base.
567 =head3 prepare_request
569 Prepare the engine request.
573 sub prepare_request { }
575 =head3 prepare_uploads
581 sub prepare_uploads { }
585 Process a coderef in given class and catch exceptions.
586 Errors are available via $c->errors.
591 my ( $c, $class, $code ) = @_;
596 my $action = $c->actions->{reverse}->{"$code"} || "$code";
598 ( $elapsed, $status ) =
599 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
600 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
603 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
605 if ( my $error = $@ ) {
607 $error = qq/Caught exception "$error"/;
608 $c->log->error($error);
609 $c->errors($error) if $c->debug;
619 $c->remove_action('!foo');
624 my ( $self, $action ) = @_;
625 if ( delete $self->actions->{regex}->{$action} ) {
626 while ( my ( $regex, $name ) = each %{ $self->actions->{compiled} } ) {
627 if ( $name eq $action ) {
628 delete $self->actions->{compiled}->{$regex};
634 delete $self->actions->{plain}->{$action};
640 Returns a C<Catalyst::Request> object.
644 =head3 response (res)
646 Returns a C<Catalyst::Response> object.
660 $self->setup_components;
661 if ( $self->debug ) {
662 my $name = $self->config->{name} || 'Application';
663 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
667 =head3 setup_components
673 sub setup_components {
677 my $class = ref $self || $self;
680 import Module::Pluggable::Fast
681 name => '_components',
683 '$class\::Controller', '$class\::C',
684 '$class\::Model', '$class\::M',
685 '$class\::View', '$class\::V'
688 if ( my $error = $@ ) {
691 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
693 $self->components( {} );
694 for my $component ( $self->_components($self) ) {
695 $self->components->{ ref $component } = $component;
697 $self->log->debug( 'Initialized components "'
698 . join( ' ', keys %{ $self->components } )
705 Returns a hashref containing all your data.
707 $c->stash->{foo} ||= 'yada';
708 print $c->stash->{foo};
715 my $stash = $_[1] ? {@_} : $_[0];
716 while ( my ( $key, $val ) = each %$stash ) {
717 $self->{stash}->{$key} = $val;
720 return $self->{stash};
724 my ( $class, $name ) = @_;
725 my $prefix = _class2prefix($class);
726 $name = "$prefix/$name" if $prefix;
732 $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
733 my $prefix = lc $1 || '';
734 $prefix =~ s/\:\:/_/g;
740 Sebastian Riedel, C<sri@cpan.org>
744 This program is free software, you can redistribute it and/or modify it under
745 the same terms as Perl itself.