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