projects / catagits/Catalyst-Runtime.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
generated apps should now require Cat5
[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 );
4716267f 130 $c->res->headers->remove_content_headers;
23f9d934 131 $c->res->status(302);
4716267f 132 return $c->finalize_headers;
23f9d934 133 }
134
a554cc3b 135 if ( !$c->res->output || $#{ $c->error } >= 0 ) {
fc7ec1d9 136 $c->res->headers->content_type('text/html');
137 my $name = $c->config->{name} || 'Catalyst Application';
a554cc3b 138 my ( $title, $error, $infos );
fc7ec1d9 139 if ( $c->debug ) {
a554cc3b 140 $error = join '<br/>', @{ $c->error };
141 $error ||= 'No output';
fc7ec1d9 142 $title = $name = "$name on Catalyst $Catalyst::VERSION";
143 my $req = encode_entities Dumper $c->req;
144 my $res = encode_entities Dumper $c->res;
145 my $stash = encode_entities Dumper $c->stash;
146 $infos = <<"";
147<br/>
148<b><u>Request</u></b><br/>
149<pre>$req</pre>
150<b><u>Response</u></b><br/>
151<pre>$res</pre>
152<b><u>Stash</u></b><br/>
153<pre>$stash</pre>
154
155 }
156 else {
a554cc3b 157 $title = $name;
158 $error = '';
159 $infos = <<"";
fc7ec1d9 160<pre>
161(en) Please come back later
162(de) Bitte versuchen sie es spaeter nocheinmal
163(nl) Gelieve te komen later terug
164(no) Vennligst prov igjen senere
165(fr) Veuillez revenir plus tard
166(es) Vuelto por favor mas adelante
167(pt) Voltado por favor mais tarde
168(it) Ritornato prego più successivamente
169</pre>
170
171 $name = '';
172 }
173 $c->res->{output} = <<"";
174<html>
175 <head>
176 <title>$title</title>
177 <style type="text/css">
178 body {
179 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
180 Tahoma, Arial, helvetica, sans-serif;
181 color: #ddd;
182 background-color: #eee;
183 margin: 0px;
184 padding: 0px;
185 }
186 div.box {
187 background-color: #ccc;
188 border: 1px solid #aaa;
189 padding: 4px;
190 margin: 10px;
191 -moz-border-radius: 10px;
192 }
a554cc3b 193 div.error {
fc7ec1d9 194 background-color: #977;
195 border: 1px solid #755;
196 padding: 8px;
197 margin: 4px;
198 margin-bottom: 10px;
199 -moz-border-radius: 10px;
200 }
201 div.infos {
202 background-color: #797;
203 border: 1px solid #575;
204 padding: 8px;
205 margin: 4px;
206 margin-bottom: 10px;
207 -moz-border-radius: 10px;
208 }
209 div.name {
210 background-color: #779;
211 border: 1px solid #557;
212 padding: 8px;
213 margin: 4px;
214 -moz-border-radius: 10px;
215 }
216 </style>
217 </head>
218 <body>
219 <div class="box">
a554cc3b 220 <div class="error">$error</div>
fc7ec1d9 221 <div class="infos">$infos</div>
222 <div class="name">$name</div>
223 </div>
224 </body>
225</html>
226
227 }
fc7ec1d9 228 $c->res->headers->content_length( length $c->res->output );
229 my $status = $c->finalize_headers;
230 $c->finalize_output;
231 return $status;
232}
233
23f9d934 234=item $c->finalize_headers
fc7ec1d9 235
236Finalize headers.
237
238=cut
239
240sub finalize_headers { }
241
23f9d934 242=item $c->finalize_output
fc7ec1d9 243
244Finalize output.
245
246=cut
247
248sub finalize_output { }
249
23f9d934 250=item $c->forward($command)
fc7ec1d9 251
ac733264 252Forward processing to a private action or a method from a class.
fc7ec1d9 253If you define a class without method it will default to process().
254
6196207f 255 $c->forward('/foo');
ac733264 256 $c->forward('index');
fc7ec1d9 257 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
258 $c->forward('MyApp::View::TT');
259
260=cut
261
262sub forward {
263 my $c = shift;
264 my $command = shift;
265 unless ($command) {
266 $c->log->debug('Nothing to forward to') if $c->debug;
267 return 0;
268 }
ac733264 269 my $caller = caller(0);
270 my $namespace = '/';
6196207f 271 if ( $command =~ /^\// ) {
89c5fe2d 272 $command =~ /^(.*)\/(\w+)$/;
273 $namespace = $1 || '/';
274 $command = $2;
275 }
ac733264 276 else { $namespace = _class2prefix($caller) || '/' }
66d9e175 277 my $results = $c->get_action( $command, $namespace );
ac733264 278 unless ( @{$results} ) {
b768faa3 279 my $class = $command;
fc7ec1d9 280 if ( $class =~ /[^\w\:]/ ) {
281 $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
282 return 0;
283 }
284 my $method = shift || 'process';
b768faa3 285 if ( my $code = $class->can($method) ) {
fc7ec1d9 286 $c->actions->{reverse}->{"$code"} = "$class->$method";
2deb0d7c 287 $results = [ [ [ $class, $code ] ] ];
fc7ec1d9 288 }
289 else {
290 $c->log->debug(qq/Couldn't forward to "$class->$method"/)
291 if $c->debug;
292 return 0;
293 }
294 }
2deb0d7c 295 for my $result ( @{$results} ) {
970cc51d 296 $c->state( $c->execute( @{ $result->[0] } ) );
2deb0d7c 297 }
b768faa3 298 return $c->state;
fc7ec1d9 299}
300
66d9e175 301=item $c->get_action( $action, $namespace )
302
303Get an action in a given namespace.
304
305=cut
306
307sub get_action {
308 my ( $c, $action, $namespace ) = @_;
309 $namespace ||= '';
ac733264 310 if ($namespace) {
311 $namespace = '' if $namespace eq '/';
66d9e175 312 my $parent = $c->tree;
313 my @results;
314 my $result = $c->actions->{private}->{ $parent->getUID }->{$action};
315 push @results, [$result] if $result;
316 my $visitor = Tree::Simple::Visitor::FindByPath->new;
317 for my $part ( split '/', $namespace ) {
318 $visitor->setSearchPath($part);
319 $parent->accept($visitor);
320 my $child = $visitor->getResult;
321 my $uid = $child->getUID if $child;
322 my $match = $c->actions->{private}->{$uid}->{$action} if $uid;
6d9a6748 323 push @results, [$match] if $match;
66d9e175 324 $parent = $child if $child;
325 }
326 return \@results;
327 }
328 elsif ( my $p = $c->actions->{plain}->{$action} ) { return [ [$p] ] }
329 elsif ( my $r = $c->actions->{regex}->{$action} ) { return [ [$r] ] }
330 else {
ac733264 331 for my $i ( 0 .. $#{ $c->actions->{compiled} } ) {
332 my $name = $c->actions->{compiled}->[$i]->[0];
333 my $regex = $c->actions->{compiled}->[$i]->[1];
66d9e175 334 if ( $action =~ $regex ) {
335 my @snippets;
336 for my $i ( 1 .. 9 ) {
337 no strict 'refs';
338 last unless ${$i};
339 push @snippets, ${$i};
340 }
341 return [ [ $c->actions->{regex}->{$name}, $name, \@snippets ] ];
342 }
343 }
344 }
345 return [];
346}
347
b76d7db8 348=item $c->handler( $class, $r )
fc7ec1d9 349
350Handles the request.
351
352=cut
353
b76d7db8 354sub handler ($$) {
fc7ec1d9 355 my ( $class, $r ) = @_;
356
357 # Always expect worst case!
358 my $status = -1;
359 eval {
360 my $handler = sub {
eb9ff8f4 361 my $c = $class->prepare($r);
362 my $action = $c->req->action;
363 my $namespace = '';
ac733264 364 $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
365 if $action eq 'default';
eb9ff8f4 366 unless ($namespace) {
0169d3a8 367 if ( my $result = $c->get_action($action) ) {
eb9ff8f4 368 $namespace = _class2prefix( $result->[0]->[0]->[0] );
7833fdfc 369 }
87e67021 370 }
ac733264 371 my $default = $action eq 'default' ? $namespace : undef;
372 my $results = $c->get_action( $action, $default );
373 $namespace ||= '/';
b768faa3 374 if ( @{$results} ) {
ac733264 375 for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
970cc51d 376 $c->state( $c->execute( @{ $begin->[0] } ) );
b768faa3 377 }
98dcf439 378 for my $result ( @{ $c->get_action( $action, $default ) }[-1] )
379 {
970cc51d 380 $c->state( $c->execute( @{ $result->[0] } ) );
ac733264 381 last unless $default;
b768faa3 382 }
98dcf439 383 for my $end ( reverse @{ $c->get_action( 'end', $namespace ) } )
384 {
970cc51d 385 $c->state( $c->execute( @{ $end->[0] } ) );
b768faa3 386 }
fc7ec1d9 387 }
388 else {
87e67021 389 my $path = $c->req->path;
390 my $error = $path
391 ? qq/Unknown resource "$path"/
7833fdfc 392 : "No default action defined";
fc7ec1d9 393 $c->log->error($error) if $c->debug;
a554cc3b 394 $c->error($error);
fc7ec1d9 395 }
396 return $c->finalize;
397 };
398 if ( $class->debug ) {
399 my $elapsed;
400 ( $elapsed, $status ) = $class->benchmark($handler);
401 $elapsed = sprintf '%f', $elapsed;
402 my $av = sprintf '%.3f', 1 / $elapsed;
403 $class->log->info( "Request took $elapsed" . "s ($av/s)" );
404 }
405 else { $status = &$handler }
406 };
407 if ( my $error = $@ ) {
408 chomp $error;
409 $class->log->error(qq/Caught exception in engine "$error"/);
410 }
411 $COUNT++;
412 return $status;
413}
414
23f9d934 415=item $c->prepare($r)
fc7ec1d9 416
a554cc3b 417Turns the engine-specific request( Apache, CGI ... )
418into a Catalyst context .
fc7ec1d9 419
420=cut
421
422sub prepare {
423 my ( $class, $r ) = @_;
424 my $c = bless {
425 request => Catalyst::Request->new(
426 {
427 arguments => [],
428 cookies => {},
429 headers => HTTP::Headers->new,
430 parameters => {},
431 snippets => [],
432 uploads => {}
433 }
434 ),
435 response => Catalyst::Response->new(
436 { cookies => {}, headers => HTTP::Headers->new, status => 200 }
437 ),
b768faa3 438 stash => {},
439 state => 0
fc7ec1d9 440 }, $class;
441 if ( $c->debug ) {
442 my $secs = time - $START || 1;
443 my $av = sprintf '%.3f', $COUNT / $secs;
444 $c->log->debug('********************************');
445 $c->log->debug("* Request $COUNT ($av/s) [$$]");
446 $c->log->debug('********************************');
447 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
448 }
449 $c->prepare_request($r);
450 $c->prepare_path;
ac733264 451 $c->prepare_headers;
1a80619d 452 $c->prepare_cookies;
0556eb49 453 $c->prepare_connection;
454 my $method = $c->req->method || '';
455 my $path = $c->req->path || '';
456 my $hostname = $c->req->hostname || '';
457 my $address = $c->req->address || '';
458 $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
459 if $c->debug;
fc7ec1d9 460 $c->prepare_action;
461 $c->prepare_parameters;
c85ff642 462
463 if ( $c->debug && keys %{ $c->req->params } ) {
464 my @params;
465 for my $key ( keys %{ $c->req->params } ) {
b5524568 466 my $value = $c->req->params->{$key} || '';
c85ff642 467 push @params, "$key=$value";
468 }
469 $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
470 }
fc7ec1d9 471 $c->prepare_uploads;
472 return $c;
473}
474
23f9d934 475=item $c->prepare_action
fc7ec1d9 476
477Prepare action.
478
479=cut
480
481sub prepare_action {
482 my $c = shift;
483 my $path = $c->req->path;
484 my @path = split /\//, $c->req->path;
485 $c->req->args( \my @args );
486 while (@path) {
7833fdfc 487 $path = join '/', @path;
0169d3a8 488 if ( my $result = ${ $c->get_action($path) }[0] ) {
fc7ec1d9 489
490 # It's a regex
491 if ($#$result) {
7e5adedd 492 my $match = $result->[1];
493 my @snippets = @{ $result->[2] };
fc7ec1d9 494 $c->log->debug(qq/Requested action "$path" matched "$match"/)
495 if $c->debug;
496 $c->log->debug(
497 'Snippets are "' . join( ' ', @snippets ) . '"' )
498 if ( $c->debug && @snippets );
499 $c->req->action($match);
500 $c->req->snippets( \@snippets );
501 }
502 else {
503 $c->req->action($path);
504 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
505 }
506 $c->req->match($path);
fc7ec1d9 507 last;
508 }
509 unshift @args, pop @path;
510 }
511 unless ( $c->req->action ) {
ac733264 512 $c->req->action('default');
87e67021 513 $c->req->match('');
fc7ec1d9 514 }
5783a9a5 515 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
516 if ( $c->debug && @args );
fc7ec1d9 517}
518
c9afa5fc 519=item $c->prepare_connection
0556eb49 520
521Prepare connection.
522
523=cut
524
525sub prepare_connection { }
526
c9afa5fc 527=item $c->prepare_cookies
fc7ec1d9 528
529Prepare cookies.
530
531=cut
532
533sub prepare_cookies { }
534
23f9d934 535=item $c->prepare_headers
fc7ec1d9 536
537Prepare headers.
538
539=cut
540
541sub prepare_headers { }
542
23f9d934 543=item $c->prepare_parameters
fc7ec1d9 544
545Prepare parameters.
546
547=cut
548
549sub prepare_parameters { }
550
23f9d934 551=item $c->prepare_path
fc7ec1d9 552
553Prepare path and base.
554
555=cut
556
557sub prepare_path { }
558
23f9d934 559=item $c->prepare_request
fc7ec1d9 560
561Prepare the engine request.
562
563=cut
564
565sub prepare_request { }
566
23f9d934 567=item $c->prepare_uploads
fc7ec1d9 568
569Prepare uploads.
570
571=cut
572
573sub prepare_uploads { }
574
970cc51d 575=item $c->execute($class, $coderef)
fc7ec1d9 576
970cc51d 577Execute a coderef in given class and catch exceptions.
a554cc3b 578Errors are available via $c->error.
fc7ec1d9 579
580=cut
581
970cc51d 582sub execute {
fc7ec1d9 583 my ( $c, $class, $code ) = @_;
a554cc3b 584 $class = $c->comp($class) || $class;
585 $c->state(0);
fc7ec1d9 586 eval {
587 if ( $c->debug )
588 {
589 my $action = $c->actions->{reverse}->{"$code"} || "$code";
a554cc3b 590 my ( $elapsed, @state ) =
fc7ec1d9 591 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
592 $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
593 if $c->debug;
a554cc3b 594 $c->state(@state);
fc7ec1d9 595 }
a554cc3b 596 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
fc7ec1d9 597 };
598 if ( my $error = $@ ) {
599 chomp $error;
600 $error = qq/Caught exception "$error"/;
601 $c->log->error($error);
a554cc3b 602 $c->error($error) if $c->debug;
603 $c->state(0);
fc7ec1d9 604 }
a554cc3b 605 return $c->state;
fc7ec1d9 606}
607
c9afa5fc 608=item $c->run
609
610Starts the engine.
611
612=cut
613
614sub run { }
615
23f9d934 616=item $c->request
617
618=item $c->req
fc7ec1d9 619
620Returns a C<Catalyst::Request> object.
621
622 my $req = $c->req;
623
23f9d934 624=item $c->response
625
626=item $c->res
fc7ec1d9 627
628Returns a C<Catalyst::Response> object.
629
630 my $res = $c->res;
631
ac733264 632=item $c->set_action( $action, $code, $namespace, $attrs )
66d9e175 633
634Set an action in a given namespace.
635
636=cut
637
638sub set_action {
ac733264 639 my ( $c, $method, $code, $namespace, $attrs ) = @_;
640
6372237c 641 my $prefix = _class2prefix($namespace) || '';
642 my %flags;
ac733264 643
644 for my $attr ( @{$attrs} ) {
98dcf439 645 if ( $attr =~ /^(Local|Relative)$/ ) { $flags{local}++ }
646 elsif ( $attr =~ /^(Global|Absolute)$/ ) { $flags{global}++ }
647 elsif ( $attr =~ /^Path\((.+)\)$/i ) { $flags{path} = $1 }
648 elsif ( $attr =~ /^Private$/i ) { $flags{private}++ }
1d4ea19d 649 elsif ( $attr =~ /^(Regex|Regexp)\((.+)\)$/i ) { $flags{regex} = $2 }
66d9e175 650 }
ac733264 651
6372237c 652 return unless keys %flags;
ac733264 653
654 my $parent = $c->tree;
655 my $visitor = Tree::Simple::Visitor::FindByPath->new;
656 for my $part ( split '/', $prefix ) {
657 $visitor->setSearchPath($part);
658 $parent->accept($visitor);
659 my $child = $visitor->getResult;
660 unless ($child) {
661 $child = $parent->addChild( Tree::Simple->new($part) );
66d9e175 662 $visitor->setSearchPath($part);
663 $parent->accept($visitor);
ac733264 664 $child = $visitor->getResult;
66d9e175 665 }
ac733264 666 $parent = $child;
66d9e175 667 }
ac733264 668 my $uid = $parent->getUID;
669 $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
670 my $forward = $prefix ? "$prefix/$method" : $method;
671 $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
a554cc3b 672 if $c->debug;
ac733264 673
6372237c 674 if ( $flags{path} ) {
675 $flags{path} =~ s/^\w+//;
676 $flags{path} =~ s/\w+$//;
677 if ( $flags{path} =~ /^'(.*)'$/ ) { $flags{path} = $1 }
678 if ( $flags{path} =~ /^"(.*)"$/ ) { $flags{path} = $1 }
679 }
680 if ( $flags{regex} ) {
681 $flags{regex} =~ s/^\w+//;
682 $flags{regex} =~ s/\w+$//;
683 if ( $flags{regex} =~ /^'(.*)'$/ ) { $flags{regex} = $1 }
684 if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 }
685 }
ac733264 686
687 my $reverse = $prefix ? "$method ($prefix)" : $method;
688
6372237c 689 if ( $flags{local} || $flags{global} || $flags{path} ) {
690 my $path = $flags{path} || $method;
691 my $absolute = 0;
692 if ( $path =~ /^\/(.+)/ ) {
693 $path = $1;
694 $absolute = 1;
ac733264 695 }
8702d594 696 $absolute = 1 if $flags{global};
6372237c 697 my $name = $absolute ? $path : "$prefix/$path";
ac733264 698 $c->actions->{plain}->{$name} = [ $namespace, $code ];
699 $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
700 }
6372237c 701 if ( my $regex = $flags{regex} ) {
702 push @{ $c->actions->{compiled} }, [ $regex, qr#$regex# ];
703 $c->actions->{regex}->{$regex} = [ $namespace, $code ];
704 $c->log->debug(qq|Public "$regex" is "/$forward"|) if $c->debug;
ac733264 705 }
706
707 $c->actions->{reverse}->{"$code"} = $reverse;
66d9e175 708}
709
23f9d934 710=item $class->setup
fc7ec1d9 711
712Setup.
713
714 MyApp->setup;
715
716=cut
717
718sub setup {
719 my $self = shift;
720 $self->setup_components;
721 if ( $self->debug ) {
722 my $name = $self->config->{name} || 'Application';
723 $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
724 }
725}
726
ac733264 727=item $class->setup_actions($component)
728
729Setup actions for a component.
730
731=cut
732
733sub setup_actions {
734 my ( $self, $comp ) = @_;
735 $comp = ref $comp || $comp;
736 for my $action ( @{ $comp->_cache } ) {
737 my ( $code, $attrs ) = @{$action};
738 my $name = '';
739 no strict 'refs';
98dcf439 740 my @cache = ( $comp, @{"$comp\::ISA"} );
bb6823f2 741 my %namespaces;
98dcf439 742 while ( my $namespace = shift @cache ) {
bb6823f2 743 $namespaces{$namespace}++;
98dcf439 744 for my $isa ( @{"$comp\::ISA"} ) {
bb6823f2 745 next if $namespaces{$isa};
98dcf439 746 push @cache, $isa;
bb6823f2 747 $namespaces{$isa}++;
98dcf439 748 }
749 }
bb6823f2 750 for my $namespace ( keys %namespaces ) {
98dcf439 751 for my $sym ( values %{ $namespace . '::' } ) {
752 if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
753 $name = *{$sym}{NAME};
754 $self->set_action( $name, $code, $comp, $attrs );
755 last;
756 }
ac733264 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 || '';
0434eec1 829 my $prefix;
98dcf439 830 if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
831 $prefix = lc $2;
832 $prefix =~ s/\:\:/\//g;
0434eec1 833 }
7833fdfc 834 return $prefix;
fc7ec1d9 835}
836
23f9d934 837=back
838
fc7ec1d9 839=head1 AUTHOR
840
841Sebastian Riedel, C<sri@cpan.org>
842
843=head1 COPYRIGHT
844
845This program is free software, you can redistribute it and/or modify it under
846the same terms as Perl itself.
847
848=cut
849
8501;
The Perl MVC Framework (catagits@git.shadowcat.co.uk:Catalyst-Runtime.git)