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 =item $c->action( $name => $coderef, ... )
46 =item $c->action( $name )
50 Add one or more actions.
52 $c->action( '!foo' => sub { $_[1]->res->output('Foo!') } );
54 Get an action's class and coderef.
56 my ($class, $code) = @{ $c->action('foo') };
58 Get a list of available actions.
60 my @actions = $c->action;
62 It also automatically calls setup() if needed.
64 See L<Catalyst::Manual::Intro> for more informations about actions.
70 $self->setup unless $self->components;
71 $self->actions( {} ) unless $self->actions;
73 $_[1] ? ( $action = {@_} ) : ( $action = shift );
74 if ( ref $action eq 'HASH' ) {
75 while ( my ( $name, $code ) = each %$action ) {
76 my $class = caller(0);
77 if ( $name =~ /^\/(.*)\/$/ ) {
79 $self->actions->{compiled}->{qr/$regex/} = $name;
80 $self->actions->{regex}->{$name} = [ $class, $code ];
82 elsif ( $name =~ /^\?(.*)$/ ) {
84 $name = _prefix( $class, $name );
85 $self->actions->{plain}->{$name} = [ $class, $code ];
87 elsif ( $name =~ /^\!\?(.*)$/ ) {
89 $name = _prefix( $class, $name );
91 $self->actions->{plain}->{$name} = [ $class, $code ];
93 else { $self->actions->{plain}->{$name} = [ $class, $code ] }
94 $self->actions->{reverse}->{"$code"} = $name;
95 $self->log->debug(qq/"$class" defined "$name" as "$code"/)
100 if ( my $p = $self->actions->{plain}->{$action} ) { return [$p] }
101 elsif ( my $r = $self->actions->{regex}->{$action} ) { return [$r] }
103 for my $regex ( keys %{ $self->actions->{compiled} } ) {
104 my $name = $self->actions->{compiled}->{$regex};
105 if ( $action =~ $regex ) {
107 for my $i ( 1 .. 9 ) {
110 push @snippets, ${$i};
112 return [ $self->actions->{regex}->{$name},
121 keys %{ $self->actions->{plain} },
122 keys %{ $self->actions->{regex} }
127 =item $c->benchmark($coderef)
129 Takes a coderef with arguments and returns elapsed time as float.
131 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
132 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
139 my $time = [gettimeofday];
140 my @return = &$code(@_);
141 my $elapsed = tv_interval $time;
142 return wantarray ? ( $elapsed, @return ) : $elapsed;
145 =item $c->comp($name)
147 =item $c->component($name)
149 Get a component object by name.
151 $c->comp('MyApp::Model::MyModel')->do_stuff;
153 Regex search for a component.
155 $c->comp('mymodel')->do_stuff;
160 my ( $c, $name ) = @_;
161 if ( my $component = $c->components->{$name} ) {
165 for my $component ( keys %{ $c->components } ) {
166 return $c->components->{$component} if $component =~ /$name/i;
173 =item $c->errors($error, ...)
175 =item $c->errors($arrayref)
177 Returns an arrayref containing errors messages.
179 my @errors = @{ $c->errors };
183 $c->errors('Something bad happened');
189 my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
190 push @{ $c->{errors} }, @$errors;
203 if ( my $location = $c->res->redirect ) {
204 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
205 $c->res->headers->header( Location => $location );
206 $c->res->status(302);
209 if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
210 $c->res->headers->content_type('text/html');
211 my $name = $c->config->{name} || 'Catalyst Application';
212 my ( $title, $errors, $infos );
214 $errors = join '<br/>', @{ $c->errors };
215 $errors ||= 'No output';
216 $title = $name = "$name on Catalyst $Catalyst::VERSION";
217 my $req = encode_entities Dumper $c->req;
218 my $res = encode_entities Dumper $c->res;
219 my $stash = encode_entities Dumper $c->stash;
222 <b><u>Request</u></b><br/>
224 <b><u>Response</u></b><br/>
226 <b><u>Stash</u></b><br/>
235 (en) Please come back later
236 (de) Bitte versuchen sie es spaeter nocheinmal
237 (nl) Gelieve te komen later terug
238 (no) Vennligst prov igjen senere
239 (fr) Veuillez revenir plus tard
240 (es) Vuelto por favor mas adelante
241 (pt) Voltado por favor mais tarde
242 (it) Ritornato prego piĆ¹ successivamente
247 $c->res->{output} = <<"";
250 <title>$title</title>
251 <style type="text/css">
253 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
254 Tahoma, Arial, helvetica, sans-serif;
256 background-color: #eee;
261 background-color: #ccc;
262 border: 1px solid #aaa;
265 -moz-border-radius: 10px;
268 background-color: #977;
269 border: 1px solid #755;
273 -moz-border-radius: 10px;
276 background-color: #797;
277 border: 1px solid #575;
281 -moz-border-radius: 10px;
284 background-color: #779;
285 border: 1px solid #557;
288 -moz-border-radius: 10px;
294 <div class="errors">$errors</div>
295 <div class="infos">$infos</div>
296 <div class="name">$name</div>
302 $c->res->headers->content_length( length $c->res->output );
303 my $status = $c->finalize_headers;
308 =item $c->finalize_headers
314 sub finalize_headers { }
316 =item $c->finalize_output
322 sub finalize_output { }
324 =item $c->forward($command)
326 Forward processing to a private/public action or a method from a class.
327 If you define a class without method it will default to process().
330 $c->forward('index.html');
331 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
332 $c->forward('MyApp::View::TT');
340 $c->log->debug('Nothing to forward to') if $c->debug;
343 if ( $command =~ /^\?(.*)$/ ) {
345 my $caller = caller(0);
346 $command = _prefix( $caller, $command );
348 elsif ( $command =~ /^\!\?(.*)$/ ) {
350 my $caller = caller(0);
351 $command = _prefix( $caller, $command );
352 $command = "\!$command";
354 elsif ( $command =~ /^\!(.*)$/ ) {
356 my $caller = caller(0);
357 my $prefix = _class2prefix($caller);
358 $try = "!$prefix/$command";
359 $command = $try if $c->actions->{plain}->{$try};
361 my ( $class, $code );
362 if ( my $action = $c->action($command) ) {
363 if ( $action->[2] ) {
364 $c->log->debug(qq/Couldn't forward "$command" to regex action/)
368 ( $class, $code ) = @{ $action->[0] };
372 if ( $class =~ /[^\w\:]/ ) {
373 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
376 my $method = shift || 'process';
377 if ( $code = $class->can($method) ) {
378 $c->actions->{reverse}->{"$code"} = "$class->$method";
381 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
386 $class = $c->components->{$class} || $class;
387 return $c->process( $class, $code );
390 =item $c->handler($r)
397 my ( $class, $r ) = @_;
399 # Always expect worst case!
403 my $c = $class->prepare($r);
404 if ( my $action = $c->action( $c->req->action ) ) {
406 my $class = ${ $action->[0] }[0];
407 my $prefix = _class2prefix($class);
409 if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
410 $begin = "\!$prefix/begin";
412 elsif ( $c->actions->{plain}->{'!begin'} ) {
415 if ( $c->actions->{plain}->{"\!$prefix/end"} ) {
416 $end = "\!$prefix/end";
418 elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
421 if ( $c->actions->{plain}->{'!begin'} ) {
424 if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
426 $c->forward($begin) if $begin;
427 $c->forward( $c->req->action ) if $c->req->action;
428 $c->forward($end) if $end;
431 my $action = $c->req->path;
433 ? qq/Unknown resource "$action"/
434 : "No default action defined";
435 $c->log->error($error) if $c->debug;
440 if ( $class->debug ) {
442 ( $elapsed, $status ) = $class->benchmark($handler);
443 $elapsed = sprintf '%f', $elapsed;
444 my $av = sprintf '%.3f', 1 / $elapsed;
445 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
447 else { $status = &$handler }
449 if ( my $error = $@ ) {
451 $class->log->error(qq/Caught exception in engine "$error"/);
457 =item $c->prepare($r)
459 Turns the engine-specific request (Apache, CGI...) into a Catalyst context.
464 my ( $class, $r ) = @_;
466 request => Catalyst::Request->new(
470 headers => HTTP::Headers->new,
476 response => Catalyst::Response->new(
477 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
482 my $secs = time - $START || 1;
483 my $av = sprintf '%.3f', $COUNT / $secs;
484 $c->log->debug('********************************');
485 $c->log->debug("* Request $COUNT ($av/s) [$$]");
486 $c->log->debug('********************************');
487 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
489 $c->prepare_request($r);
493 $c->prepare_connection;
494 my $method = $c->req->method || '';
495 my $path = $c->req->path || '';
496 my $hostname = $c->req->hostname || '';
497 my $address = $c->req->address || '';
498 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
501 $c->prepare_parameters;
503 if ( $c->debug && keys %{ $c->req->params } ) {
505 for my $key ( keys %{ $c->req->params } ) {
506 my $value = $c->req->params->{$key} || '';
507 push @params, "$key=$value";
509 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
515 =item $c->prepare_action
523 my $path = $c->req->path;
524 my @path = split /\//, $c->req->path;
525 $c->req->args( \my @args );
527 $path = join '/', @path;
528 if ( my $result = $c->action($path) ) {
532 my $match = $result->[1];
533 my @snippets = @{ $result->[2] };
534 $c->log->debug(qq/Requested action "$path" matched "$match"/)
537 'Snippets are "' . join( ' ', @snippets ) . '"' )
538 if ( $c->debug && @snippets );
539 $c->req->action($match);
540 $c->req->snippets( \@snippets );
543 $c->req->action($path);
544 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
546 $c->req->match($path);
549 unshift @args, pop @path;
551 unless ( $c->req->action ) {
552 my $prefix = $c->req->args->[0];
553 if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) {
555 $c->req->action("\!$prefix/default");
556 $c->log->debug('Using prefixed default action') if $c->debug;
558 elsif ( $c->actions->{plain}->{'!default'} ) {
560 $c->req->action('!default');
561 $c->log->debug('Using default action') if $c->debug;
564 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
565 if ( $c->debug && @args );
568 =item $c->prepare_connection;
574 sub prepare_connection { }
576 =item $c->prepare_cookies;
582 sub prepare_cookies { }
584 =item $c->prepare_headers
590 sub prepare_headers { }
592 =item $c->prepare_parameters
598 sub prepare_parameters { }
600 =item $c->prepare_path
602 Prepare path and base.
608 =item $c->prepare_request
610 Prepare the engine request.
614 sub prepare_request { }
616 =item $c->prepare_uploads
622 sub prepare_uploads { }
624 =item $c->process($class, $coderef)
626 Process a coderef in given class and catch exceptions.
627 Errors are available via $c->errors.
632 my ( $c, $class, $code ) = @_;
637 my $action = $c->actions->{reverse}->{"$code"} || "$code";
639 ( $elapsed, $status ) =
640 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
641 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
644 else { $status = &$code( $class, $c, @{ $c->req->args } ) }
646 if ( my $error = $@ ) {
648 $error = qq/Caught exception "$error"/;
649 $c->log->error($error);
650 $c->errors($error) if $c->debug;
656 =item $c->remove_action($action)
660 $c->remove_action('!foo');
665 my ( $self, $action ) = @_;
666 if ( delete $self->actions->{regex}->{$action} ) {
667 while ( my ( $regex, $name ) = each %{ $self->actions->{compiled} } ) {
668 if ( $name eq $action ) {
669 delete $self->actions->{compiled}->{$regex};
675 delete $self->actions->{plain}->{$action};
683 Returns a C<Catalyst::Request> object.
691 Returns a C<Catalyst::Response> object.
705 $self->setup_components;
706 if ( $self->debug ) {
707 my $name = $self->config->{name} || 'Application';
708 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
712 =item $class->setup_components
718 sub setup_components {
722 my $class = ref $self || $self;
725 import Module::Pluggable::Fast
726 name => '_components',
728 '$class\::Controller', '$class\::C',
729 '$class\::Model', '$class\::M',
730 '$class\::View', '$class\::V'
733 if ( my $error = $@ ) {
736 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
738 $self->components( {} );
739 for my $component ( $self->_components($self) ) {
740 $self->components->{ ref $component } = $component;
742 $self->log->debug( 'Initialized components "'
743 . join( ' ', keys %{ $self->components } )
750 Returns a hashref containing all your data.
752 $c->stash->{foo} ||= 'yada';
753 print $c->stash->{foo};
760 my $stash = $_[1] ? {@_} : $_[0];
761 while ( my ( $key, $val ) = each %$stash ) {
762 $self->{stash}->{$key} = $val;
765 return $self->{stash};
769 my ( $class, $name ) = @_;
770 my $prefix = _class2prefix($class);
771 $name = "$prefix/$name" if $prefix;
777 $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
778 my $prefix = lc $1 || '';
779 $prefix =~ s/\:\:/_/g;
787 Sebastian Riedel, C<sri@cpan.org>
791 This program is free software, you can redistribute it and/or modify it under
792 the same terms as Perl itself.