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