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