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