lib/Catalyst/Engine.pm

   1 package Catalyst::Engine;
   2
   3 use strict;
   4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
   5 use UNIVERSAL::require;
   6 use Data::Dumper;
   7 use HTML::Entities;
   8 use HTTP::Headers;
   9 use Memoize;
  10 use Time::HiRes qw/gettimeofday tv_interval/;
  11 use Tree::Simple;
  12 use Tree::Simple::Visitor::FindByPath;
  13 use Catalyst::Request;
  14 use Catalyst::Response;
  15
  16 require Module::Pluggable::Fast;
  17
  18 $Data::Dumper::Terse = 1;
  19
  20 __PACKAGE__->mk_classdata($_) for qw/actions components tree/;
  21 __PACKAGE__->mk_accessors(qw/request response state/);
  22
  23 __PACKAGE__->actions(
  24     { plain => {}, private => {}, regex => {}, compiled => [], reverse => {} }
  25 );
  26 __PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
  27
  28 *comp = \&component;
  29 *req  = \&request;
  30 *res  = \&response;
  31
  32 our $COUNT = 1;
  33 our $START = time;
  34
  35 memoize('_class2prefix');
  36
  37 =head1 NAME
  38
  39 Catalyst::Engine - The Catalyst Engine
  40
  41 =head1 SYNOPSIS
  42
  43 See L<Catalyst>.
  44
  45 =head1 DESCRIPTION
  46
  47 =head1 METHODS
  48
  49 =over 4
  50
  51 =item $c->benchmark($coderef)
  52
  53 Takes 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
  60 sub 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
  69 =item $c->comp($name)
  70
  71 =item $c->component($name)
  72
  73 Get a component object by name.
  74
  75     $c->comp('MyApp::Model::MyModel')->do_stuff;
  76
  77 Regex search for a component.
  78
  79     $c->comp('mymodel')->do_stuff;
  80
  81 =cut
  82
  83 sub 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
  95 =item $c->error
  96
  97 =item $c->error($error, ...)
  98
  99 =item $c->error($arrayref)
 100
 101 Returns an arrayref containing error messages.
 102
 103     my @error = @{ $c->error };
 104
 105 Add a new error.
 106
 107     $c->error('Something bad happened');
 108
 109 =cut
 110
 111 sub error {
 112     my $c = shift;
 113     my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 114     push @{ $c->{error} }, @$error;
 115     return $c->{error};
 116 }
 117
 118 =item $c->finalize
 119
 120 Finalize request.
 121
 122 =cut
 123
 124 sub finalize {
 125     my $c = shift;
 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
 133     if ( !$c->res->output || $#{ $c->error } >= 0 ) {
 134         $c->res->headers->content_type('text/html');
 135         my $name = $c->config->{name} || 'Catalyst Application';
 136         my ( $title, $error, $infos );
 137         if ( $c->debug ) {
 138             $error = join '<br/>', @{ $c->error };
 139             $error ||= 'No output';
 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 {
 155             $title = $name;
 156             $error = '';
 157             $infos = <<"";
 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             }
 191             div.error {
 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">
 218             <div class="error">$error</div>
 219             <div class="infos">$infos</div>
 220             <div class="name">$name</div>
 221         </div>
 222     </body>
 223 </html>
 224
 225     }
 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
 232 =item $c->finalize_headers
 233
 234 Finalize headers.
 235
 236 =cut
 237
 238 sub finalize_headers { }
 239
 240 =item $c->finalize_output
 241
 242 Finalize output.
 243
 244 =cut
 245
 246 sub finalize_output { }
 247
 248 =item $c->forward($command)
 249
 250 Forward processing to a private action or a method from a class.
 251 If you define a class without method it will default to process().
 252
 253     $c->forward('foo');
 254     $c->forward('index');
 255     $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
 256     $c->forward('MyApp::View::TT');
 257
 258 =cut
 259
 260 sub 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     }
 267     my $caller    = caller(0);
 268     my $namespace = '/';
 269     if ( $command =~ /^\/$/ ) {
 270         $command =~ /^(.*)\/(\w+)$/;
 271         $namespace = $1 || '/';
 272         $command = $2;
 273     }
 274     else { $namespace = _class2prefix($caller) || '/' }
 275     my $results = $c->get_action( $command, $namespace );
 276     unless ( @{$results} ) {
 277         my $class = $command;
 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';
 283         if ( my $code = $class->can($method) ) {
 284             $c->actions->{reverse}->{"$code"} = "$class->$method";
 285             $results = [ [ [ $class, $code ] ] ];
 286         }
 287         else {
 288             $c->log->debug(qq/Couldn't forward to "$class->$method"/)
 289               if $c->debug;
 290             return 0;
 291         }
 292     }
 293     for my $result ( @{$results} ) {
 294         $c->state( $c->execute( @{ $result->[0] } ) );
 295     }
 296     return $c->state;
 297 }
 298
 299 =item $c->get_action( $action, $namespace )
 300
 301 Get an action in a given namespace.
 302
 303 =cut
 304
 305 sub get_action {
 306     my ( $c, $action, $namespace ) = @_;
 307     $namespace ||= '';
 308     if ($namespace) {
 309         $namespace = '' if $namespace eq '/';
 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;
 321             push @results, [$match] if $match;
 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 {
 329         for my $i ( 0 .. $#{ $c->actions->{compiled} } ) {
 330             my $name  = $c->actions->{compiled}->[$i]->[0];
 331             my $regex = $c->actions->{compiled}->[$i]->[1];
 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
 346 =item $c->handler( $class, $r )
 347
 348 Handles the request.
 349
 350 =cut
 351
 352 sub handler ($$) {
 353     my ( $class, $r ) = @_;
 354
 355     # Always expect worst case!
 356     my $status = -1;
 357     eval {
 358         my $handler = sub {
 359             my $c         = $class->prepare($r);
 360             my $action    = $c->req->action;
 361             my $namespace = '';
 362             $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
 363               if $action eq 'default';
 364             unless ($namespace) {
 365                 if ( my $result = $c->get_action($action) ) {
 366                     $namespace = _class2prefix( $result->[0]->[0]->[0] );
 367                 }
 368             }
 369             my $default = $action eq 'default' ? $namespace : undef;
 370             my $results = $c->get_action( $action, $default );
 371             $namespace ||= '/';
 372             if ( @{$results} ) {
 373                 for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
 374                     $c->state( $c->execute( @{ $begin->[0] } ) );
 375                 }
 376                 for my $result ( @{ $c->get_action( $action, $default ) } ) {
 377                     $c->state( $c->execute( @{ $result->[0] } ) );
 378                     last unless $default;
 379                 }
 380                 for my $end ( @{ $c->get_action( 'end', $namespace ) } ) {
 381                     $c->state( $c->execute( @{ $end->[0] } ) );
 382                 }
 383             }
 384             else {
 385                 my $path  = $c->req->path;
 386                 my $error = $path
 387                   ? qq/Unknown resource "$path"/
 388                   : "No default action defined";
 389                 $c->log->error($error) if $c->debug;
 390                 $c->error($error);
 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
 411 =item $c->prepare($r)
 412
 413 Turns the engine-specific request( Apache, CGI ... )
 414 into a Catalyst context .
 415
 416 =cut
 417
 418 sub 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         ),
 434         stash => {},
 435         state => 0
 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;
 447     $c->prepare_cookies;
 448     $c->prepare_headers;
 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;
 456     $c->prepare_action;
 457     $c->prepare_parameters;
 458
 459     if ( $c->debug && keys %{ $c->req->params } ) {
 460         my @params;
 461         for my $key ( keys %{ $c->req->params } ) {
 462             my $value = $c->req->params->{$key} || '';
 463             push @params, "$key=$value";
 464         }
 465         $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
 466     }
 467     $c->prepare_uploads;
 468     return $c;
 469 }
 470
 471 =item $c->prepare_action
 472
 473 Prepare action.
 474
 475 =cut
 476
 477 sub 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) {
 483         $path = join '/', @path;
 484         if ( my $result = ${ $c->get_action($path) }[0] ) {
 485
 486             # It's a regex
 487             if ($#$result) {
 488                 my $match    = $result->[1];
 489                 my @snippets = @{ $result->[2] };
 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);
 503             last;
 504         }
 505         unshift @args, pop @path;
 506     }
 507     unless ( $c->req->action ) {
 508         $c->req->action('default');
 509         $c->req->match('');
 510     }
 511     $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
 512       if ( $c->debug && @args );
 513 }
 514
 515 =item $c->prepare_connection
 516
 517 Prepare connection.
 518
 519 =cut
 520
 521 sub prepare_connection { }
 522
 523 =item $c->prepare_cookies
 524
 525 Prepare cookies.
 526
 527 =cut
 528
 529 sub prepare_cookies { }
 530
 531 =item $c->prepare_headers
 532
 533 Prepare headers.
 534
 535 =cut
 536
 537 sub prepare_headers { }
 538
 539 =item $c->prepare_parameters
 540
 541 Prepare parameters.
 542
 543 =cut
 544
 545 sub prepare_parameters { }
 546
 547 =item $c->prepare_path
 548
 549 Prepare path and base.
 550
 551 =cut
 552
 553 sub prepare_path { }
 554
 555 =item $c->prepare_request
 556
 557 Prepare the engine request.
 558
 559 =cut
 560
 561 sub prepare_request { }
 562
 563 =item $c->prepare_uploads
 564
 565 Prepare uploads.
 566
 567 =cut
 568
 569 sub prepare_uploads { }
 570
 571 =item $c->execute($class, $coderef)
 572
 573 Execute a coderef in given class and catch exceptions.
 574 Errors are available via $c->error.
 575
 576 =cut
 577
 578 sub execute {
 579     my ( $c, $class, $code ) = @_;
 580     $class = $c->comp($class) || $class;
 581     $c->state(0);
 582     eval {
 583         if ( $c->debug )
 584         {
 585             my $action = $c->actions->{reverse}->{"$code"} || "$code";
 586             my ( $elapsed, @state ) =
 587               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
 588             $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
 589               if $c->debug;
 590             $c->state(@state);
 591         }
 592         else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
 593     };
 594     if ( my $error = $@ ) {
 595         chomp $error;
 596         $error = qq/Caught exception "$error"/;
 597         $c->log->error($error);
 598         $c->error($error) if $c->debug;
 599         $c->state(0);
 600     }
 601     return $c->state;
 602 }
 603
 604 =item $c->run
 605
 606 Starts the engine.
 607
 608 =cut
 609
 610 sub run { }
 611
 612 =item $c->request
 613
 614 =item $c->req
 615
 616 Returns a C<Catalyst::Request> object.
 617
 618     my $req = $c->req;
 619
 620 =item $c->response
 621
 622 =item $c->res
 623
 624 Returns a C<Catalyst::Response> object.
 625
 626     my $res = $c->res;
 627
 628 =item $c->set_action( $action, $code, $namespace, $attrs )
 629
 630 Set an action in a given namespace.
 631
 632 =cut
 633
 634 sub set_action {
 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         }
 675     }
 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) );
 687             $visitor->setSearchPath($part);
 688             $parent->accept($visitor);
 689             $child = $visitor->getResult;
 690         }
 691         $parent = $child;
 692     }
 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"|)
 697       if $c->debug;
 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;
 725 }
 726
 727 =item $class->setup
 728
 729 Setup.
 730
 731     MyApp->setup;
 732
 733 =cut
 734
 735 sub 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
 744 =item $class->setup_actions($component)
 745
 746 Setup actions for a component.
 747
 748 =cut
 749
 750 sub 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
 766 =item $class->setup_components
 767
 768 Setup components.
 769
 770 =cut
 771
 772 sub 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     }
 792     $self->setup_actions($self);
 793     $self->components( {} );
 794     for my $comp ( $self->_components($self) ) {
 795         $self->components->{ ref $comp } = $comp;
 796         $self->setup_actions($comp);
 797     }
 798     $self->log->debug( 'Initialized components "'
 799           . join( ' ', keys %{ $self->components } )
 800           . '"' )
 801       if $self->debug;
 802 }
 803
 804 =item $c->stash
 805
 806 Returns a hashref containing all your data.
 807
 808     $c->stash->{foo} ||= 'yada';
 809     print $c->stash->{foo};
 810
 811 =cut
 812
 813 sub 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
 824 sub _prefix {
 825     my ( $class, $name ) = @_;
 826     my $prefix = _class2prefix($class);
 827     $name = "$prefix/$name" if $prefix;
 828     return $name;
 829 }
 830
 831 sub _class2prefix {
 832     my $class = shift || '';
 833     $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
 834     my $prefix = lc $2 || '';
 835     $prefix =~ s/\:\:/\//g;
 836     return $prefix;
 837 }
 838
 839 =back
 840
 841 =head1 AUTHOR
 842
 843 Sebastian Riedel, C<sri@cpan.org>
 844
 845 =head1 COPYRIGHT
 846
 847 This program is free software, you can redistribute it and/or modify it under
 848 the same terms as Perl itself.
 849
 850 =cut
 851
 852 1;