projects / catagits/Catalyst-Runtime.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
whole new syntax
[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} ) {
a554cc3b 290 $c->state( $c->process( @{ $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;
317 push @results, [$match] if $match;
318 $parent = $child if $child;
319 }
320 return \@results;
321 }
322 elsif ( my $p = $c->actions->{plain}->{$action} ) { return [ [$p] ] }
323 elsif ( my $r = $c->actions->{regex}->{$action} ) { return [ [$r] ] }
324 else {
ac733264 325 for my $i ( 0 .. $#{ $c->actions->{compiled} } ) {
326 my $name = $c->actions->{compiled}->[$i]->[0];
327 my $regex = $c->actions->{compiled}->[$i]->[1];
66d9e175 328 if ( $action =~ $regex ) {
329 my @snippets;
330 for my $i ( 1 .. 9 ) {
331 no strict 'refs';
332 last unless ${$i};
333 push @snippets, ${$i};
334 }
335 return [ [ $c->actions->{regex}->{$name}, $name, \@snippets ] ];
336 }
337 }
338 }
339 return [];
340}
341
b76d7db8 342=item $c->handler( $class, $r )
fc7ec1d9 343
344Handles the request.
345
346=cut
347
b76d7db8 348sub handler ($$) {
fc7ec1d9 349 my ( $class, $r ) = @_;
350
351 # Always expect worst case!
352 my $status = -1;
353 eval {
354 my $handler = sub {
eb9ff8f4 355 my $c = $class->prepare($r);
356 my $action = $c->req->action;
357 my $namespace = '';
ac733264 358 $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
359 if $action eq 'default';
eb9ff8f4 360 unless ($namespace) {
0169d3a8 361 if ( my $result = $c->get_action($action) ) {
eb9ff8f4 362 $namespace = _class2prefix( $result->[0]->[0]->[0] );
7833fdfc 363 }
87e67021 364 }
ac733264 365 my $default = $action eq 'default' ? $namespace : undef;
366 my $results = $c->get_action( $action, $default );
367 $namespace ||= '/';
b768faa3 368 if ( @{$results} ) {
ac733264 369 for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
d6f060b7 370 $c->state( $c->process( @{ $begin->[0] } ) );
b768faa3 371 }
ac733264 372 for my $result ( @{ $c->get_action( $action, $default ) } ) {
d6f060b7 373 $c->state( $c->process( @{ $result->[0] } ) );
ac733264 374 last unless $default;
b768faa3 375 }
ac733264 376 for my $end ( @{ $c->get_action( 'end', $namespace ) } ) {
d6f060b7 377 $c->state( $c->process( @{ $end->[0] } ) );
b768faa3 378 }
fc7ec1d9 379 }
380 else {
87e67021 381 my $path = $c->req->path;
382 my $error = $path
383 ? qq/Unknown resource "$path"/
7833fdfc 384 : "No default action defined";
fc7ec1d9 385 $c->log->error($error) if $c->debug;
a554cc3b 386 $c->error($error);
fc7ec1d9 387 }
388 return $c->finalize;
389 };
390 if ( $class->debug ) {
391 my $elapsed;
392 ( $elapsed, $status ) = $class->benchmark($handler);
393 $elapsed = sprintf '%f', $elapsed;
394 my $av = sprintf '%.3f', 1 / $elapsed;
395 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
396 }
397 else { $status = &$handler }
398 };
399 if ( my $error = $@ ) {
400 chomp $error;
401 $class->log->error(qq/Caught exception in engine "$error"/);
402 }
403 $COUNT++;
404 return $status;
405}
406
23f9d934 407=item $c->prepare($r)
fc7ec1d9 408
a554cc3b 409Turns the engine-specific request( Apache, CGI ... )
410into a Catalyst context .
fc7ec1d9 411
412=cut
413
414sub prepare {
415 my ( $class, $r ) = @_;
416 my $c = bless {
417 request => Catalyst::Request->new(
418 {
419 arguments => [],
420 cookies => {},
421 headers => HTTP::Headers->new,
422 parameters => {},
423 snippets => [],
424 uploads => {}
425 }
426 ),
427 response => Catalyst::Response->new(
428 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
429 ),
b768faa3 430 stash => {},
431 state => 0
fc7ec1d9 432 }, $class;
433 if ( $c->debug ) {
434 my $secs = time - $START || 1;
435 my $av = sprintf '%.3f', $COUNT / $secs;
436 $c->log->debug('********************************');
437 $c->log->debug("* Request $COUNT ($av/s) [$$]");
438 $c->log->debug('********************************');
439 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
440 }
441 $c->prepare_request($r);
442 $c->prepare_path;
b333ca6b 443 $c->prepare_cookies;
ac733264 444 $c->prepare_headers;
0556eb49 445 $c->prepare_connection;
446 my $method = $c->req->method || '';
447 my $path = $c->req->path || '';
448 my $hostname = $c->req->hostname || '';
449 my $address = $c->req->address || '';
450 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
451 if $c->debug;
fc7ec1d9 452 $c->prepare_action;
453 $c->prepare_parameters;
c85ff642 454
455 if ( $c->debug && keys %{ $c->req->params } ) {
456 my @params;
457 for my $key ( keys %{ $c->req->params } ) {
b5524568 458 my $value = $c->req->params->{$key} || '';
c85ff642 459 push @params, "$key=$value";
460 }
461 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
462 }
fc7ec1d9 463 $c->prepare_uploads;
464 return $c;
465}
466
23f9d934 467=item $c->prepare_action
fc7ec1d9 468
469Prepare action.
470
471=cut
472
473sub prepare_action {
474 my $c = shift;
475 my $path = $c->req->path;
476 my @path = split /\//, $c->req->path;
477 $c->req->args( \my @args );
478 while (@path) {
7833fdfc 479 $path = join '/', @path;
0169d3a8 480 if ( my $result = ${ $c->get_action($path) }[0] ) {
fc7ec1d9 481
482 # It's a regex
483 if ($#$result) {
7e5adedd 484 my $match = $result->[1];
485 my @snippets = @{ $result->[2] };
fc7ec1d9 486 $c->log->debug(qq/Requested action "$path" matched "$match"/)
487 if $c->debug;
488 $c->log->debug(
489 'Snippets are "' . join( ' ', @snippets ) . '"' )
490 if ( $c->debug && @snippets );
491 $c->req->action($match);
492 $c->req->snippets( \@snippets );
493 }
494 else {
495 $c->req->action($path);
496 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
497 }
498 $c->req->match($path);
fc7ec1d9 499 last;
500 }
501 unshift @args, pop @path;
502 }
503 unless ( $c->req->action ) {
ac733264 504 $c->req->action('default');
87e67021 505 $c->req->match('');
fc7ec1d9 506 }
5783a9a5 507 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
508 if ( $c->debug && @args );
fc7ec1d9 509}
510
c9afa5fc 511=item $c->prepare_connection
0556eb49 512
513Prepare connection.
514
515=cut
516
517sub prepare_connection { }
518
c9afa5fc 519=item $c->prepare_cookies
fc7ec1d9 520
521Prepare cookies.
522
523=cut
524
525sub prepare_cookies { }
526
23f9d934 527=item $c->prepare_headers
fc7ec1d9 528
529Prepare headers.
530
531=cut
532
533sub prepare_headers { }
534
23f9d934 535=item $c->prepare_parameters
fc7ec1d9 536
537Prepare parameters.
538
539=cut
540
541sub prepare_parameters { }
542
23f9d934 543=item $c->prepare_path
fc7ec1d9 544
545Prepare path and base.
546
547=cut
548
549sub prepare_path { }
550
23f9d934 551=item $c->prepare_request
fc7ec1d9 552
553Prepare the engine request.
554
555=cut
556
557sub prepare_request { }
558
23f9d934 559=item $c->prepare_uploads
fc7ec1d9 560
561Prepare uploads.
562
563=cut
564
565sub prepare_uploads { }
566
23f9d934 567=item $c->process($class, $coderef)
fc7ec1d9 568
569Process a coderef in given class and catch exceptions.
a554cc3b 570Errors are available via $c->error.
fc7ec1d9 571
572=cut
573
574sub process {
575 my ( $c, $class, $code ) = @_;
a554cc3b 576 $class = $c->comp($class) || $class;
577 $c->state(0);
fc7ec1d9 578 eval {
579 if ( $c->debug )
580 {
581 my $action = $c->actions->{reverse}->{"$code"} || "$code";
a554cc3b 582 my ( $elapsed, @state ) =
fc7ec1d9 583 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
584 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
585 if $c->debug;
a554cc3b 586 $c->state(@state);
fc7ec1d9 587 }
a554cc3b 588 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
fc7ec1d9 589 };
590 if ( my $error = $@ ) {
591 chomp $error;
592 $error = qq/Caught exception "$error"/;
593 $c->log->error($error);
a554cc3b 594 $c->error($error) if $c->debug;
595 $c->state(0);
fc7ec1d9 596 }
a554cc3b 597 return $c->state;
fc7ec1d9 598}
599
c9afa5fc 600=item $c->run
601
602Starts the engine.
603
604=cut
605
606sub run { }
607
23f9d934 608=item $c->request
609
610=item $c->req
fc7ec1d9 611
612Returns a C<Catalyst::Request> object.
613
614 my $req = $c->req;
615
23f9d934 616=item $c->response
617
618=item $c->res
fc7ec1d9 619
620Returns a C<Catalyst::Response> object.
621
622 my $res = $c->res;
623
ac733264 624=item $c->set_action( $action, $code, $namespace, $attrs )
66d9e175 625
626Set an action in a given namespace.
627
628=cut
629
630sub set_action {
ac733264 631 my ( $c, $method, $code, $namespace, $attrs ) = @_;
632
633 my $prefix = _class2prefix($namespace) || '';
634 my $action = 0;
635 my $public = 0;
636 my $regex = 0;
637 my $arg = '';
638 my $absolute = 0;
639
640 for my $attr ( @{$attrs} ) {
641 if ( $attr =~ /^Action$/ ) {
642 $action++;
643 $arg = $1 if $1;
644 }
645 elsif ( $attr =~ /^Path\((.+)\)$/i ) {
646 $arg = $1;
647 $public++;
648 }
649 elsif ( $attr =~ /^Public$/i ) {
650 $public++;
651 }
652 elsif ( $attr =~ /^Private$/i ) {
653 $action++;
654 }
655 elsif ( $attr =~ /Regex(?:\((.+)\))?$/i ) {
656 $regex++;
657 $action++;
658 $arg = $1 if $1;
659 }
660 elsif ( $attr =~ /Absolute(?:\((.+)\))?$/i ) {
661 $action++;
662 $absolute++;
663 $public++;
664 $arg = $1 if $1;
665 }
666 elsif ( $attr =~ /Relative(?:\((.+)\))?$/i ) {
667 $action++;
668 $public++;
669 $arg = $1 if $1;
670 }
66d9e175 671 }
ac733264 672
673 return unless $action;
674
675 my $parent = $c->tree;
676 my $visitor = Tree::Simple::Visitor::FindByPath->new;
677 for my $part ( split '/', $prefix ) {
678 $visitor->setSearchPath($part);
679 $parent->accept($visitor);
680 my $child = $visitor->getResult;
681 unless ($child) {
682 $child = $parent->addChild( Tree::Simple->new($part) );
66d9e175 683 $visitor->setSearchPath($part);
684 $parent->accept($visitor);
ac733264 685 $child = $visitor->getResult;
66d9e175 686 }
ac733264 687 $parent = $child;
66d9e175 688 }
ac733264 689 my $uid = $parent->getUID;
690 $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
691 my $forward = $prefix ? "$prefix/$method" : $method;
692 $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
a554cc3b 693 if $c->debug;
ac733264 694
695 $arg =~ s/^\w+//;
696 $arg =~ s/\w+$//;
697 if ( $arg =~ /^'(.*)'$/ ) { $arg = $1 }
698 if ( $arg =~ /^"(.*)"$/ ) { $arg = $1 }
699
700 my $reverse = $prefix ? "$method ($prefix)" : $method;
701
702 if ($public) {
703 my $is_absolute = 0;
704 $is_absolute = 1 if $absolute;
705 if ( $arg =~ /^\/(.+)/ ) {
706 $arg = $1;
707 $is_absolute = 1;
708 }
709 my $name =
710 $is_absolute ? ( $arg || $method ) : "$prefix/" . ( $arg || $method );
711 $c->actions->{plain}->{$name} = [ $namespace, $code ];
712 $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
713 }
714 if ($regex) {
715 push @{ $c->actions->{compiled} }, [ $arg, qr#$arg# ];
716 $c->actions->{regex}->{$arg} = [ $namespace, $code ];
717 $c->log->debug(qq|Public "$arg" is "/$forward"|) if $c->debug;
718 }
719
720 $c->actions->{reverse}->{"$code"} = $reverse;
66d9e175 721}
722
23f9d934 723=item $class->setup
fc7ec1d9 724
725Setup.
726
727 MyApp->setup;
728
729=cut
730
731sub setup {
732 my $self = shift;
733 $self->setup_components;
734 if ( $self->debug ) {
735 my $name = $self->config->{name} || 'Application';
736 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
737 }
738}
739
ac733264 740=item $class->setup_actions($component)
741
742Setup actions for a component.
743
744=cut
745
746sub setup_actions {
747 my ( $self, $comp ) = @_;
748 $comp = ref $comp || $comp;
749 for my $action ( @{ $comp->_cache } ) {
750 my ( $code, $attrs ) = @{$action};
751 my $name = '';
752 no strict 'refs';
753 for my $sym ( values %{ $comp . '::' } ) {
754 if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
755 $name = *{$sym}{NAME};
756 $self->set_action( $name, $code, $comp, $attrs );
757 }
758 }
759 }
760}
761
23f9d934 762=item $class->setup_components
fc7ec1d9 763
764Setup components.
765
766=cut
767
768sub setup_components {
769 my $self = shift;
770
771 # Components
772 my $class = ref $self || $self;
773 eval <<"";
774 package $class;
775 import Module::Pluggable::Fast
776 name => '_components',
777 search => [
778 '$class\::Controller', '$class\::C',
779 '$class\::Model', '$class\::M',
780 '$class\::View', '$class\::V'
781 ];
782
783 if ( my $error = $@ ) {
784 chomp $error;
785 $self->log->error(
786 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
787 }
ac733264 788 $self->setup_actions($self);
fc7ec1d9 789 $self->components( {} );
ac733264 790 for my $comp ( $self->_components($self) ) {
791 $self->components->{ ref $comp } = $comp;
792 $self->setup_actions($comp);
fc7ec1d9 793 }
794 $self->log->debug( 'Initialized components "'
795 . join( ' ', keys %{ $self->components } )
796 . '"' )
797 if $self->debug;
798}
799
23f9d934 800=item $c->stash
fc7ec1d9 801
802Returns a hashref containing all your data.
803
804 $c->stash->{foo} ||= 'yada';
805 print $c->stash->{foo};
806
807=cut
808
809sub stash {
810 my $self = shift;
811 if ( $_[0] ) {
812 my $stash = $_[1] ? {@_} : $_[0];
813 while ( my ( $key, $val ) = each %$stash ) {
814 $self->{stash}->{$key} = $val;
815 }
816 }
817 return $self->{stash};
818}
819
820sub _prefix {
821 my ( $class, $name ) = @_;
7833fdfc 822 my $prefix = _class2prefix($class);
823 $name = "$prefix/$name" if $prefix;
824 return $name;
825}
826
827sub _class2prefix {
b768faa3 828 my $class = shift || '';
829 $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
87e67021 830 my $prefix = lc $2 || '';
831 $prefix =~ s/\:\:/\//g;
7833fdfc 832 return $prefix;
fc7ec1d9 833}
834
23f9d934 835=back
836
fc7ec1d9 837=head1 AUTHOR
838
839Sebastian Riedel, C<sri@cpan.org>
840
841=head1 COPYRIGHT
842
843This program is free software, you can redistribute it and/or modify it under
844the same terms as Perl itself.
845
846=cut
847
8481;
The Perl MVC Framework (catagits@git.shadowcat.co.uk:Catalyst-Runtime.git)