projects / catagits/Catalyst-Runtime.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
fixed forward
[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
637 my $prefix = _class2prefix($namespace) || '';
638 my $action = 0;
639 my $public = 0;
640 my $regex = 0;
641 my $arg = '';
642 my $absolute = 0;
643
644 for my $attr ( @{$attrs} ) {
645 if ( $attr =~ /^Action$/ ) {
646 $action++;
647 $arg = $1 if $1;
648 }
649 elsif ( $attr =~ /^Path\((.+)\)$/i ) {
650 $arg = $1;
651 $public++;
652 }
653 elsif ( $attr =~ /^Public$/i ) {
654 $public++;
655 }
656 elsif ( $attr =~ /^Private$/i ) {
657 $action++;
658 }
659 elsif ( $attr =~ /Regex(?:\((.+)\))?$/i ) {
660 $regex++;
661 $action++;
662 $arg = $1 if $1;
663 }
664 elsif ( $attr =~ /Absolute(?:\((.+)\))?$/i ) {
665 $action++;
666 $absolute++;
667 $public++;
668 $arg = $1 if $1;
669 }
670 elsif ( $attr =~ /Relative(?:\((.+)\))?$/i ) {
671 $action++;
672 $public++;
673 $arg = $1 if $1;
674 }
66d9e175 675 }
ac733264 676
677 return unless $action;
678
679 my $parent = $c->tree;
680 my $visitor = Tree::Simple::Visitor::FindByPath->new;
681 for my $part ( split '/', $prefix ) {
682 $visitor->setSearchPath($part);
683 $parent->accept($visitor);
684 my $child = $visitor->getResult;
685 unless ($child) {
686 $child = $parent->addChild( Tree::Simple->new($part) );
66d9e175 687 $visitor->setSearchPath($part);
688 $parent->accept($visitor);
ac733264 689 $child = $visitor->getResult;
66d9e175 690 }
ac733264 691 $parent = $child;
66d9e175 692 }
ac733264 693 my $uid = $parent->getUID;
694 $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
695 my $forward = $prefix ? "$prefix/$method" : $method;
696 $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
a554cc3b 697 if $c->debug;
ac733264 698
699 $arg =~ s/^\w+//;
700 $arg =~ s/\w+$//;
701 if ( $arg =~ /^'(.*)'$/ ) { $arg = $1 }
702 if ( $arg =~ /^"(.*)"$/ ) { $arg = $1 }
703
704 my $reverse = $prefix ? "$method ($prefix)" : $method;
705
706 if ($public) {
707 my $is_absolute = 0;
708 $is_absolute = 1 if $absolute;
709 if ( $arg =~ /^\/(.+)/ ) {
710 $arg = $1;
711 $is_absolute = 1;
712 }
713 my $name =
714 $is_absolute ? ( $arg || $method ) : "$prefix/" . ( $arg || $method );
715 $c->actions->{plain}->{$name} = [ $namespace, $code ];
716 $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
717 }
718 if ($regex) {
719 push @{ $c->actions->{compiled} }, [ $arg, qr#$arg# ];
720 $c->actions->{regex}->{$arg} = [ $namespace, $code ];
721 $c->log->debug(qq|Public "$arg" is "/$forward"|) if $c->debug;
722 }
723
724 $c->actions->{reverse}->{"$code"} = $reverse;
66d9e175 725}
726
23f9d934 727=item $class->setup
fc7ec1d9 728
729Setup.
730
731 MyApp->setup;
732
733=cut
734
735sub setup {
736 my $self = shift;
737 $self->setup_components;
738 if ( $self->debug ) {
739 my $name = $self->config->{name} || 'Application';
740 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
741 }
742}
743
ac733264 744=item $class->setup_actions($component)
745
746Setup actions for a component.
747
748=cut
749
750sub setup_actions {
751 my ( $self, $comp ) = @_;
752 $comp = ref $comp || $comp;
753 for my $action ( @{ $comp->_cache } ) {
754 my ( $code, $attrs ) = @{$action};
755 my $name = '';
756 no strict 'refs';
757 for my $sym ( values %{ $comp . '::' } ) {
758 if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
759 $name = *{$sym}{NAME};
760 $self->set_action( $name, $code, $comp, $attrs );
761 }
762 }
763 }
764}
765
23f9d934 766=item $class->setup_components
fc7ec1d9 767
768Setup components.
769
770=cut
771
772sub setup_components {
773 my $self = shift;
774
775 # Components
776 my $class = ref $self || $self;
777 eval <<"";
778 package $class;
779 import Module::Pluggable::Fast
780 name => '_components',
781 search => [
782 '$class\::Controller', '$class\::C',
783 '$class\::Model', '$class\::M',
784 '$class\::View', '$class\::V'
785 ];
786
787 if ( my $error = $@ ) {
788 chomp $error;
789 $self->log->error(
790 qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
791 }
ac733264 792 $self->setup_actions($self);
fc7ec1d9 793 $self->components( {} );
ac733264 794 for my $comp ( $self->_components($self) ) {
795 $self->components->{ ref $comp } = $comp;
796 $self->setup_actions($comp);
fc7ec1d9 797 }
798 $self->log->debug( 'Initialized components "'
799 . join( ' ', keys %{ $self->components } )
800 . '"' )
801 if $self->debug;
802}
803
23f9d934 804=item $c->stash
fc7ec1d9 805
806Returns a hashref containing all your data.
807
808 $c->stash->{foo} ||= 'yada';
809 print $c->stash->{foo};
810
811=cut
812
813sub stash {
814 my $self = shift;
815 if ( $_[0] ) {
816 my $stash = $_[1] ? {@_} : $_[0];
817 while ( my ( $key, $val ) = each %$stash ) {
818 $self->{stash}->{$key} = $val;
819 }
820 }
821 return $self->{stash};
822}
823
824sub _prefix {
825 my ( $class, $name ) = @_;
7833fdfc 826 my $prefix = _class2prefix($class);
827 $name = "$prefix/$name" if $prefix;
828 return $name;
829}
830
831sub _class2prefix {
b768faa3 832 my $class = shift || '';
833 $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
87e67021 834 my $prefix = lc $2 || '';
835 $prefix =~ s/\:\:/\//g;
7833fdfc 836 return $prefix;
fc7ec1d9 837}
838
23f9d934 839=back
840
fc7ec1d9 841=head1 AUTHOR
842
843Sebastian Riedel, C<sri@cpan.org>
844
845=head1 COPYRIGHT
846
847This program is free software, you can redistribute it and/or modify it under
848the same terms as Perl itself.
849
850=cut
851
8521;
The Perl MVC Framework (catagits@git.shadowcat.co.uk:Catalyst-Runtime.git)