projects / catagits/Catalyst-Runtime.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
fixed end inheritance
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine.pm
CommitLineData
fc7ec1d9 1package Catalyst::Engine;
2
3use strict;
4use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
5use UNIVERSAL::require;
fc7ec1d9 6use Data::Dumper;
7use HTML::Entities;
8use HTTP::Headers;
87e67021 9use Memoize;
fc7ec1d9 10use Time::HiRes qw/gettimeofday tv_interval/;
87e67021 11use Tree::Simple;
12use Tree::Simple::Visitor::FindByPath;
fc7ec1d9 13use Catalyst::Request;
14use Catalyst::Response;
15
16require Module::Pluggable::Fast;
17
18$Data::Dumper::Terse = 1;
19
87e67021 20__PACKAGE__->mk_classdata($_) for qw/actions components tree/;
b768faa3 21__PACKAGE__->mk_accessors(qw/request response state/);
fc7ec1d9 22
23__PACKAGE__->actions(
ac733264 24 { plain => {}, private => {}, regex => {}, compiled => [], reverse => {} }
87e67021 25);
26__PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
fc7ec1d9 27
28*comp = \&component;
29*req = \&request;
30*res = \&response;
31
32our $COUNT = 1;
33our $START = time;
34
87e67021 35memoize('_class2prefix');
36
fc7ec1d9 37=head1 NAME
38
39Catalyst::Engine - The Catalyst Engine
40
41=head1 SYNOPSIS
42
43See L<Catalyst>.
44
45=head1 DESCRIPTION
46
23f9d934 47=head1 METHODS
fc7ec1d9 48
23f9d934 49=over 4
50
23f9d934 51=item $c->benchmark($coderef)
fc7ec1d9 52
53Takes a coderef with arguments and returns elapsed time as float.
54
55 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
56 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
57
58=cut
59
60sub benchmark {
61 my $c = shift;
62 my $code = shift;
63 my $time = [gettimeofday];
64 my @return = &$code(@_);
65 my $elapsed = tv_interval $time;
66 return wantarray ? ( $elapsed, @return ) : $elapsed;
67}
68
23f9d934 69=item $c->comp($name)
70
71=item $c->component($name)
fc7ec1d9 72
73Get a component object by name.
74
75 $c->comp('MyApp::Model::MyModel')->do_stuff;
76
77Regex search for a component.
78
79 $c->comp('mymodel')->do_stuff;
80
81=cut
82
83sub component {
84 my ( $c, $name ) = @_;
85 if ( my $component = $c->components->{$name} ) {
86 return $component;
87 }
88 else {
89 for my $component ( keys %{ $c->components } ) {
90 return $c->components->{$component} if $component =~ /$name/i;
91 }
92 }
93}
94
a554cc3b 95=item $c->error
23f9d934 96
a554cc3b 97=item $c->error($error, ...)
23f9d934 98
a554cc3b 99=item $c->error($arrayref)
fc7ec1d9 100
a554cc3b 101Returns an arrayref containing error messages.
fc7ec1d9 102
a554cc3b 103 my @error = @{ $c->error };
fc7ec1d9 104
105Add a new error.
106
a554cc3b 107 $c->error('Something bad happened');
fc7ec1d9 108
109=cut
110
a554cc3b 111sub error {
fc7ec1d9 112 my $c = shift;
a554cc3b 113 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
114 push @{ $c->{error} }, @$error;
115 return $c->{error};
fc7ec1d9 116}
117
23f9d934 118=item $c->finalize
fc7ec1d9 119
120Finalize request.
121
122=cut
123
124sub finalize {
125 my $c = shift;
23f9d934 126
127 if ( my $location = $c->res->redirect ) {
128 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
129 $c->res->headers->header( Location => $location );
130 $c->res->status(302);
131 }
132
a554cc3b 133 if ( !$c->res->output || $#{ $c->error } >= 0 ) {
fc7ec1d9 134 $c->res->headers->content_type('text/html');
135 my $name = $c->config->{name} || 'Catalyst Application';
a554cc3b 136 my ( $title, $error, $infos );
fc7ec1d9 137 if ( $c->debug ) {
a554cc3b 138 $error = join '<br/>', @{ $c->error };
139 $error ||= 'No output';
fc7ec1d9 140 $title = $name = "$name on Catalyst $Catalyst::VERSION";
141 my $req = encode_entities Dumper $c->req;
142 my $res = encode_entities Dumper $c->res;
143 my $stash = encode_entities Dumper $c->stash;
144 $infos = <<"";
145<br/>
146<b><u>Request</u></b><br/>
147<pre>$req</pre>
148<b><u>Response</u></b><br/>
149<pre>$res</pre>
150<b><u>Stash</u></b><br/>
151<pre>$stash</pre>
152
153 }
154 else {
a554cc3b 155 $title = $name;
156 $error = '';
157 $infos = <<"";
fc7ec1d9 158<pre>
159(en) Please come back later
160(de) Bitte versuchen sie es spaeter nocheinmal
161(nl) Gelieve te komen later terug
162(no) Vennligst prov igjen senere
163(fr) Veuillez revenir plus tard
164(es) Vuelto por favor mas adelante
165(pt) Voltado por favor mais tarde
166(it) Ritornato prego più successivamente
167</pre>
168
169 $name = '';
170 }
171 $c->res->{output} = <<"";
172<html>
173 <head>
174 <title>$title</title>
175 <style type="text/css">
176 body {
177 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
178 Tahoma, Arial, helvetica, sans-serif;
179 color: #ddd;
180 background-color: #eee;
181 margin: 0px;
182 padding: 0px;
183 }
184 div.box {
185 background-color: #ccc;
186 border: 1px solid #aaa;
187 padding: 4px;
188 margin: 10px;
189 -moz-border-radius: 10px;
190 }
a554cc3b 191 div.error {
fc7ec1d9 192 background-color: #977;
193 border: 1px solid #755;
194 padding: 8px;
195 margin: 4px;
196 margin-bottom: 10px;
197 -moz-border-radius: 10px;
198 }
199 div.infos {
200 background-color: #797;
201 border: 1px solid #575;
202 padding: 8px;
203 margin: 4px;
204 margin-bottom: 10px;
205 -moz-border-radius: 10px;
206 }
207 div.name {
208 background-color: #779;
209 border: 1px solid #557;
210 padding: 8px;
211 margin: 4px;
212 -moz-border-radius: 10px;
213 }
214 </style>
215 </head>
216 <body>
217 <div class="box">
a554cc3b 218 <div class="error">$error</div>
fc7ec1d9 219 <div class="infos">$infos</div>
220 <div class="name">$name</div>
221 </div>
222 </body>
223</html>
224
225 }
fc7ec1d9 226 $c->res->headers->content_length( length $c->res->output );
227 my $status = $c->finalize_headers;
228 $c->finalize_output;
229 return $status;
230}
231
23f9d934 232=item $c->finalize_headers
fc7ec1d9 233
234Finalize headers.
235
236=cut
237
238sub finalize_headers { }
239
23f9d934 240=item $c->finalize_output
fc7ec1d9 241
242Finalize output.
243
244=cut
245
246sub finalize_output { }
247
23f9d934 248=item $c->forward($command)
fc7ec1d9 249
ac733264 250Forward processing to a private action or a method from a class.
fc7ec1d9 251If you define a class without method it will default to process().
252
ac733264 253 $c->forward('foo');
254 $c->forward('index');
fc7ec1d9 255 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
256 $c->forward('MyApp::View::TT');
257
258=cut
259
260sub forward {
261 my $c = shift;
262 my $command = shift;
263 unless ($command) {
264 $c->log->debug('Nothing to forward to') if $c->debug;
265 return 0;
266 }
ac733264 267 my $caller = caller(0);
268 my $namespace = '/';
269 if ( $command =~ /^\/(.*)$/ ) { $command = $1 }
270 else { $namespace = _class2prefix($caller) || '/' }
66d9e175 271 my $results = $c->get_action( $command, $namespace );
ac733264 272 unless ( @{$results} ) {
b768faa3 273 my $class = $command;
fc7ec1d9 274 if ( $class =~ /[^\w\:]/ ) {
275 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
276 return 0;
277 }
278 my $method = shift || 'process';
b768faa3 279 if ( my $code = $class->can($method) ) {
fc7ec1d9 280 $c->actions->{reverse}->{"$code"} = "$class->$method";
2deb0d7c 281 $results = [ [ [ $class, $code ] ] ];
fc7ec1d9 282 }
283 else {
284 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
285 if $c->debug;
286 return 0;
287 }
288 }
2deb0d7c 289 for my $result ( @{$results} ) {
970cc51d 290 $c->state( $c->execute( @{ $result->[0] } ) );
2deb0d7c 291 }
b768faa3 292 return $c->state;
fc7ec1d9 293}
294
66d9e175 295=item $c->get_action( $action, $namespace )
296
297Get an action in a given namespace.
298
299=cut
300
301sub get_action {
302 my ( $c, $action, $namespace ) = @_;
303 $namespace ||= '';
ac733264 304 if ($namespace) {
305 $namespace = '' if $namespace eq '/';
66d9e175 306 my $parent = $c->tree;
307 my @results;
308 my $result = $c->actions->{private}->{ $parent->getUID }->{$action};
309 push @results, [$result] if $result;
310 my $visitor = Tree::Simple::Visitor::FindByPath->new;
311 for my $part ( split '/', $namespace ) {
312 $visitor->setSearchPath($part);
313 $parent->accept($visitor);
314 my $child = $visitor->getResult;
315 my $uid = $child->getUID if $child;
316 my $match = $c->actions->{private}->{$uid}->{$action} if $uid;
f8568ac8 317 if ($match) {
318 $action eq 'end' ? unshift @results, [$match] : push @results,
319 [$match];
320 }
66d9e175 321 $parent = $child if $child;
322 }
323 return \@results;
324 }
325 elsif ( my $p = $c->actions->{plain}->{$action} ) { return [ [$p] ] }
326 elsif ( my $r = $c->actions->{regex}->{$action} ) { return [ [$r] ] }
327 else {
ac733264 328 for my $i ( 0 .. $#{ $c->actions->{compiled} } ) {
329 my $name = $c->actions->{compiled}->[$i]->[0];
330 my $regex = $c->actions->{compiled}->[$i]->[1];
66d9e175 331 if ( $action =~ $regex ) {
332 my @snippets;
333 for my $i ( 1 .. 9 ) {
334 no strict 'refs';
335 last unless ${$i};
336 push @snippets, ${$i};
337 }
338 return [ [ $c->actions->{regex}->{$name}, $name, \@snippets ] ];
339 }
340 }
341 }
342 return [];
343}
344
b76d7db8 345=item $c->handler( $class, $r )
fc7ec1d9 346
347Handles the request.
348
349=cut
350
b76d7db8 351sub handler ($$) {
fc7ec1d9 352 my ( $class, $r ) = @_;
353
354 # Always expect worst case!
355 my $status = -1;
356 eval {
357 my $handler = sub {
eb9ff8f4 358 my $c = $class->prepare($r);
359 my $action = $c->req->action;
360 my $namespace = '';
ac733264 361 $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
362 if $action eq 'default';
eb9ff8f4 363 unless ($namespace) {
0169d3a8 364 if ( my $result = $c->get_action($action) ) {
eb9ff8f4 365 $namespace = _class2prefix( $result->[0]->[0]->[0] );
7833fdfc 366 }
87e67021 367 }
ac733264 368 my $default = $action eq 'default' ? $namespace : undef;
369 my $results = $c->get_action( $action, $default );
370 $namespace ||= '/';
b768faa3 371 if ( @{$results} ) {
ac733264 372 for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
970cc51d 373 $c->state( $c->execute( @{ $begin->[0] } ) );
b768faa3 374 }
ac733264 375 for my $result ( @{ $c->get_action( $action, $default ) } ) {
970cc51d 376 $c->state( $c->execute( @{ $result->[0] } ) );
ac733264 377 last unless $default;
b768faa3 378 }
ac733264 379 for my $end ( @{ $c->get_action( 'end', $namespace ) } ) {
970cc51d 380 $c->state( $c->execute( @{ $end->[0] } ) );
b768faa3 381 }
fc7ec1d9 382 }
383 else {
87e67021 384 my $path = $c->req->path;
385 my $error = $path
386 ? qq/Unknown resource "$path"/
7833fdfc 387 : "No default action defined";
fc7ec1d9 388 $c->log->error($error) if $c->debug;
a554cc3b 389 $c->error($error);
fc7ec1d9 390 }
391 return $c->finalize;
392 };
393 if ( $class->debug ) {
394 my $elapsed;
395 ( $elapsed, $status ) = $class->benchmark($handler);
396 $elapsed = sprintf '%f', $elapsed;
397 my $av = sprintf '%.3f', 1 / $elapsed;
398 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
399 }
400 else { $status = &$handler }
401 };
402 if ( my $error = $@ ) {
403 chomp $error;
404 $class->log->error(qq/Caught exception in engine "$error"/);
405 }
406 $COUNT++;
407 return $status;
408}
409
23f9d934 410=item $c->prepare($r)
fc7ec1d9 411
a554cc3b 412Turns the engine-specific request( Apache, CGI ... )
413into a Catalyst context .
fc7ec1d9 414
415=cut
416
417sub prepare {
418 my ( $class, $r ) = @_;
419 my $c = bless {
420 request => Catalyst::Request->new(
421 {
422 arguments => [],
423 cookies => {},
424 headers => HTTP::Headers->new,
425 parameters => {},
426 snippets => [],
427 uploads => {}
428 }
429 ),
430 response => Catalyst::Response->new(
431 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
432 ),
b768faa3 433 stash => {},
434 state => 0
fc7ec1d9 435 }, $class;
436 if ( $c->debug ) {
437 my $secs = time - $START || 1;
438 my $av = sprintf '%.3f', $COUNT / $secs;
439 $c->log->debug('********************************');
440 $c->log->debug("* Request $COUNT ($av/s) [$$]");
441 $c->log->debug('********************************');
442 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
443 }
444 $c->prepare_request($r);
445 $c->prepare_path;
b333ca6b 446 $c->prepare_cookies;
ac733264 447 $c->prepare_headers;
0556eb49 448 $c->prepare_connection;
449 my $method = $c->req->method || '';
450 my $path = $c->req->path || '';
451 my $hostname = $c->req->hostname || '';
452 my $address = $c->req->address || '';
453 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
454 if $c->debug;
fc7ec1d9 455 $c->prepare_action;
456 $c->prepare_parameters;
c85ff642 457
458 if ( $c->debug && keys %{ $c->req->params } ) {
459 my @params;
460 for my $key ( keys %{ $c->req->params } ) {
b5524568 461 my $value = $c->req->params->{$key} || '';
c85ff642 462 push @params, "$key=$value";
463 }
464 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
465 }
fc7ec1d9 466 $c->prepare_uploads;
467 return $c;
468}
469
23f9d934 470=item $c->prepare_action
fc7ec1d9 471
472Prepare action.
473
474=cut
475
476sub prepare_action {
477 my $c = shift;
478 my $path = $c->req->path;
479 my @path = split /\//, $c->req->path;
480 $c->req->args( \my @args );
481 while (@path) {
7833fdfc 482 $path = join '/', @path;
0169d3a8 483 if ( my $result = ${ $c->get_action($path) }[0] ) {
fc7ec1d9 484
485 # It's a regex
486 if ($#$result) {
7e5adedd 487 my $match = $result->[1];
488 my @snippets = @{ $result->[2] };
fc7ec1d9 489 $c->log->debug(qq/Requested action "$path" matched "$match"/)
490 if $c->debug;
491 $c->log->debug(
492 'Snippets are "' . join( ' ', @snippets ) . '"' )
493 if ( $c->debug && @snippets );
494 $c->req->action($match);
495 $c->req->snippets( \@snippets );
496 }
497 else {
498 $c->req->action($path);
499 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
500 }
501 $c->req->match($path);
fc7ec1d9 502 last;
503 }
504 unshift @args, pop @path;
505 }
506 unless ( $c->req->action ) {
ac733264 507 $c->req->action('default');
87e67021 508 $c->req->match('');
fc7ec1d9 509 }
5783a9a5 510 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
511 if ( $c->debug && @args );
fc7ec1d9 512}
513
c9afa5fc 514=item $c->prepare_connection
0556eb49 515
516Prepare connection.
517
518=cut
519
520sub prepare_connection { }
521
c9afa5fc 522=item $c->prepare_cookies
fc7ec1d9 523
524Prepare cookies.
525
526=cut
527
528sub prepare_cookies { }
529
23f9d934 530=item $c->prepare_headers
fc7ec1d9 531
532Prepare headers.
533
534=cut
535
536sub prepare_headers { }
537
23f9d934 538=item $c->prepare_parameters
fc7ec1d9 539
540Prepare parameters.
541
542=cut
543
544sub prepare_parameters { }
545
23f9d934 546=item $c->prepare_path
fc7ec1d9 547
548Prepare path and base.
549
550=cut
551
552sub prepare_path { }
553
23f9d934 554=item $c->prepare_request
fc7ec1d9 555
556Prepare the engine request.
557
558=cut
559
560sub prepare_request { }
561
23f9d934 562=item $c->prepare_uploads
fc7ec1d9 563
564Prepare uploads.
565
566=cut
567
568sub prepare_uploads { }
569
970cc51d 570=item $c->execute($class, $coderef)
fc7ec1d9 571
970cc51d 572Execute a coderef in given class and catch exceptions.
a554cc3b 573Errors are available via $c->error.
fc7ec1d9 574
575=cut
576
970cc51d 577sub execute {
fc7ec1d9 578 my ( $c, $class, $code ) = @_;
a554cc3b 579 $class = $c->comp($class) || $class;
580 $c->state(0);
fc7ec1d9 581 eval {
582 if ( $c->debug )
583 {
584 my $action = $c->actions->{reverse}->{"$code"} || "$code";
a554cc3b 585 my ( $elapsed, @state ) =
fc7ec1d9 586 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
587 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
588 if $c->debug;
a554cc3b 589 $c->state(@state);
fc7ec1d9 590 }
a554cc3b 591 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
fc7ec1d9 592 };
593 if ( my $error = $@ ) {
594 chomp $error;
595 $error = qq/Caught exception "$error"/;
596 $c->log->error($error);
a554cc3b 597 $c->error($error) if $c->debug;
598 $c->state(0);
fc7ec1d9 599 }
a554cc3b 600 return $c->state;
fc7ec1d9 601}
602
c9afa5fc 603=item $c->run
604
605Starts the engine.
606
607=cut
608
609sub run { }
610
23f9d934 611=item $c->request
612
613=item $c->req
fc7ec1d9 614
615Returns a C<Catalyst::Request> object.
616
617 my $req = $c->req;
618
23f9d934 619=item $c->response
620
621=item $c->res
fc7ec1d9 622
623Returns a C<Catalyst::Response> object.
624
625 my $res = $c->res;
626
ac733264 627=item $c->set_action( $action, $code, $namespace, $attrs )
66d9e175 628
629Set an action in a given namespace.
630
631=cut
632
633sub set_action {
ac733264 634 my ( $c, $method, $code, $namespace, $attrs ) = @_;
635
636 my $prefix = _class2prefix($namespace) || '';
637 my $action = 0;
638 my $public = 0;
639 my $regex = 0;
640 my $arg = '';
641 my $absolute = 0;
642
643 for my $attr ( @{$attrs} ) {
644 if ( $attr =~ /^Action$/ ) {
645 $action++;
646 $arg = $1 if $1;
647 }
648 elsif ( $attr =~ /^Path\((.+)\)$/i ) {
649 $arg = $1;
650 $public++;
651 }
652 elsif ( $attr =~ /^Public$/i ) {
653 $public++;
654 }
655 elsif ( $attr =~ /^Private$/i ) {
656 $action++;
657 }
658 elsif ( $attr =~ /Regex(?:\((.+)\))?$/i ) {
659 $regex++;
660 $action++;
661 $arg = $1 if $1;
662 }
663 elsif ( $attr =~ /Absolute(?:\((.+)\))?$/i ) {
664 $action++;
665 $absolute++;
666 $public++;
667 $arg = $1 if $1;
668 }
669 elsif ( $attr =~ /Relative(?:\((.+)\))?$/i ) {
670 $action++;
671 $public++;
672 $arg = $1 if $1;
673 }
66d9e175 674 }
ac733264 675
676 return unless $action;
677
678 my $parent = $c->tree;
679 my $visitor = Tree::Simple::Visitor::FindByPath->new;
680 for my $part ( split '/', $prefix ) {
681 $visitor->setSearchPath($part);
682 $parent->accept($visitor);
683 my $child = $visitor->getResult;
684 unless ($child) {
685 $child = $parent->addChild( Tree::Simple->new($part) );
66d9e175 686 $visitor->setSearchPath($part);
687 $parent->accept($visitor);
ac733264 688 $child = $visitor->getResult;
66d9e175 689 }
ac733264 690 $parent = $child;
66d9e175 691 }
ac733264 692 my $uid = $parent->getUID;
693 $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
694 my $forward = $prefix ? "$prefix/$method" : $method;
695 $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
a554cc3b 696 if $c->debug;
ac733264 697
698 $arg =~ s/^\w+//;
699 $arg =~ s/\w+$//;
700 if ( $arg =~ /^'(.*)'$/ ) { $arg = $1 }
701 if ( $arg =~ /^"(.*)"$/ ) { $arg = $1 }
702
703 my $reverse = $prefix ? "$method ($prefix)" : $method;
704
705 if ($public) {
706 my $is_absolute = 0;
707 $is_absolute = 1 if $absolute;
708 if ( $arg =~ /^\/(.+)/ ) {
709 $arg = $1;
710 $is_absolute = 1;
711 }
712 my $name =
713 $is_absolute ? ( $arg || $method ) : "$prefix/" . ( $arg || $method );
714 $c->actions->{plain}->{$name} = [ $namespace, $code ];
715 $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
716 }
717 if ($regex) {
718 push @{ $c->actions->{compiled} }, [ $arg, qr#$arg# ];
719 $c->actions->{regex}->{$arg} = [ $namespace, $code ];
720 $c->log->debug(qq|Public "$arg" is "/$forward"|) if $c->debug;
721 }
722
723 $c->actions->{reverse}->{"$code"} = $reverse;
66d9e175 724}
725
23f9d934 726=item $class->setup
fc7ec1d9 727
728Setup.
729
730 MyApp->setup;
731
732=cut
733
734sub setup {
735 my $self = shift;
736 $self->setup_components;
737 if ( $self->debug ) {
738 my $name = $self->config->{name} || 'Application';
739 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
740 }
741}
742
ac733264 743=item $class->setup_actions($component)
744
745Setup actions for a component.
746
747=cut
748
749sub setup_actions {
750 my ( $self, $comp ) = @_;
751 $comp = ref $comp || $comp;
752 for my $action ( @{ $comp->_cache } ) {
753 my ( $code, $attrs ) = @{$action};
754 my $name = '';
755 no strict 'refs';
756 for my $sym ( values %{ $comp . '::' } ) {
757 if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
758 $name = *{$sym}{NAME};
759 $self->set_action( $name, $code, $comp, $attrs );
760 }
761 }
762 }
763}
764
23f9d934 765=item $class->setup_components
fc7ec1d9 766
767Setup components.
768
769=cut
770
771sub setup_components {
772 my $self = shift;
773
774 # Components
775 my $class = ref $self || $self;
776 eval <<"";
777 package $class;
778 import Module::Pluggable::Fast
779 name => '_components',
780 search => [
781 '$class\::Controller', '$class\::C',
782 '$class\::Model', '$class\::M',
783 '$class\::View', '$class\::V'
784 ];
785
786 if ( my $error = $@ ) {
787 chomp $error;
788 $self->log->error(
789 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
790 }
ac733264 791 $self->setup_actions($self);
fc7ec1d9 792 $self->components( {} );
ac733264 793 for my $comp ( $self->_components($self) ) {
794 $self->components->{ ref $comp } = $comp;
795 $self->setup_actions($comp);
fc7ec1d9 796 }
797 $self->log->debug( 'Initialized components "'
798 . join( ' ', keys %{ $self->components } )
799 . '"' )
800 if $self->debug;
801}
802
23f9d934 803=item $c->stash
fc7ec1d9 804
805Returns a hashref containing all your data.
806
807 $c->stash->{foo} ||= 'yada';
808 print $c->stash->{foo};
809
810=cut
811
812sub stash {
813 my $self = shift;
814 if ( $_[0] ) {
815 my $stash = $_[1] ? {@_} : $_[0];
816 while ( my ( $key, $val ) = each %$stash ) {
817 $self->{stash}->{$key} = $val;
818 }
819 }
820 return $self->{stash};
821}
822
823sub _prefix {
824 my ( $class, $name ) = @_;
7833fdfc 825 my $prefix = _class2prefix($class);
826 $name = "$prefix/$name" if $prefix;
827 return $name;
828}
829
830sub _class2prefix {
b768faa3 831 my $class = shift || '';
832 $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
87e67021 833 my $prefix = lc $2 || '';
834 $prefix =~ s/\:\:/\//g;
7833fdfc 835 return $prefix;
fc7ec1d9 836}
837
23f9d934 838=back
839
fc7ec1d9 840=head1 AUTHOR
841
842Sebastian Riedel, C<sri@cpan.org>
843
844=head1 COPYRIGHT
845
846This program is free software, you can redistribute it and/or modify it under
847the same terms as Perl itself.
848
849=cut
850
8511;
The Perl MVC Framework (catagits@git.shadowcat.co.uk:Catalyst-Runtime.git)