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 %flags;
 639
 640     for my $attr ( @{$attrs} ) {
 641         if    ( $attr =~ /^Local$/ )         { $flags{local}++ }
 642         elsif ( $attr =~ /^Global$/ )        { $flags{global}++ }
 643         elsif ( $attr =~ /^Path\((.+)\)$/i ) { $flags{path} = $1 }
 644         elsif ( $attr =~ /^Private$/i )      { $flags{private}++ }
 645         elsif ( $attr =~ /Regex\((.+)\)$/i ) { $flags{regex} = $1 }
 646     }
 647
 648     return unless keys %flags;
 649
 650     my $parent  = $c->tree;
 651     my $visitor = Tree::Simple::Visitor::FindByPath->new;
 652     for my $part ( split '/', $prefix ) {
 653         $visitor->setSearchPath($part);
 654         $parent->accept($visitor);
 655         my $child = $visitor->getResult;
 656         unless ($child) {
 657             $child = $parent->addChild( Tree::Simple->new($part) );
 658             $visitor->setSearchPath($part);
 659             $parent->accept($visitor);
 660             $child = $visitor->getResult;
 661         }
 662         $parent = $child;
 663     }
 664     my $uid = $parent->getUID;
 665     $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
 666     my $forward = $prefix ? "$prefix/$method" : $method;
 667     $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
 668       if $c->debug;
 669
 670     if ( $flags{path} ) {
 671         $flags{path} =~ s/^\w+//;
 672         $flags{path} =~ s/\w+$//;
 673         if ( $flags{path} =~ /^'(.*)'$/ ) { $flags{path} = $1 }
 674         if ( $flags{path} =~ /^"(.*)"$/ ) { $flags{path} = $1 }
 675     }
 676     if ( $flags{regex} ) {
 677         $flags{regex} =~ s/^\w+//;
 678         $flags{regex} =~ s/\w+$//;
 679         if ( $flags{regex} =~ /^'(.*)'$/ ) { $flags{regex} = $1 }
 680         if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 }
 681     }
 682
 683     my $reverse = $prefix ? "$method ($prefix)" : $method;
 684
 685     if ( $flags{local} || $flags{global} || $flags{path} ) {
 686         my $path = $flags{path} || $method;
 687         my $absolute = 0;
 688         if ( $path =~ /^\/(.+)/ ) {
 689             $path     = $1;
 690             $absolute = 1;
 691         }
 692         $absolute = 1 if $flags{global};
 693         my $name = $absolute ? $path : "$prefix/$path";
 694         $c->actions->{plain}->{$name} = [ $namespace, $code ];
 695         $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
 696     }
 697     if ( my $regex = $flags{regex} ) {
 698         push @{ $c->actions->{compiled} }, [ $regex, qr#$regex# ];
 699         $c->actions->{regex}->{$regex} = [ $namespace, $code ];
 700         $c->log->debug(qq|Public "$regex" is "/$forward"|) if $c->debug;
 701     }
 702
 703     $c->actions->{reverse}->{"$code"} = $reverse;
 704 }
 705
 706 =item $class->setup
 707
 708 Setup.
 709
 710     MyApp->setup;
 711
 712 =cut
 713
 714 sub setup {
 715     my $self = shift;
 716     $self->setup_components;
 717     if ( $self->debug ) {
 718         my $name = $self->config->{name} || 'Application';
 719         $self->log->info("$name powered by Catalyst $Catalyst::VERSION");
 720     }
 721 }
 722
 723 =item $class->setup_actions($component)
 724
 725 Setup actions for a component.
 726
 727 =cut
 728
 729 sub setup_actions {
 730     my ( $self, $comp ) = @_;
 731     $comp = ref $comp || $comp;
 732     for my $action ( @{ $comp->_cache } ) {
 733         my ( $code, $attrs ) = @{$action};
 734         my $name = '';
 735         no strict 'refs';
 736         for my $sym ( values %{ $comp . '::' } ) {
 737             if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
 738                 $name = *{$sym}{NAME};
 739                 $self->set_action( $name, $code, $comp, $attrs );
 740             }
 741         }
 742     }
 743 }
 744
 745 =item $class->setup_components
 746
 747 Setup components.
 748
 749 =cut
 750
 751 sub setup_components {
 752     my $self = shift;
 753
 754     # Components
 755     my $class = ref $self || $self;
 756     eval <<"";
 757         package $class;
 758         import Module::Pluggable::Fast
 759           name   => '_components',
 760           search => [
 761             '$class\::Controller', '$class\::C',
 762             '$class\::Model',      '$class\::M',
 763             '$class\::View',       '$class\::V'
 764           ];
 765
 766     if ( my $error = $@ ) {
 767         chomp $error;
 768         $self->log->error(
 769             qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
 770     }
 771     $self->setup_actions($self);
 772     $self->components( {} );
 773     for my $comp ( $self->_components($self) ) {
 774         $self->components->{ ref $comp } = $comp;
 775         $self->setup_actions($comp);
 776     }
 777     $self->log->debug( 'Initialized components "'
 778           . join( ' ', keys %{ $self->components } )
 779           . '"' )
 780       if $self->debug;
 781 }
 782
 783 =item $c->stash
 784
 785 Returns a hashref containing all your data.
 786
 787     $c->stash->{foo} ||= 'yada';
 788     print $c->stash->{foo};
 789
 790 =cut
 791
 792 sub stash {
 793     my $self = shift;
 794     if ( $_[0] ) {
 795         my $stash = $_[1] ? {@_} : $_[0];
 796         while ( my ( $key, $val ) = each %$stash ) {
 797             $self->{stash}->{$key} = $val;
 798         }
 799     }
 800     return $self->{stash};
 801 }
 802
 803 sub _prefix {
 804     my ( $class, $name ) = @_;
 805     my $prefix = _class2prefix($class);
 806     $name = "$prefix/$name" if $prefix;
 807     return $name;
 808 }
 809
 810 sub _class2prefix {
 811     my $class = shift || '';
 812     my $prefix;
 813     if ($class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/) {
 814       $prefix = lc $2;
 815       $prefix =~ s/\:\:/\//g;
 816     }
 817     return $prefix;
 818 }
 819
 820 =back
 821
 822 =head1 AUTHOR
 823
 824 Sebastian Riedel, C<sri@cpan.org>
 825
 826 =head1 COPYRIGHT
 827
 828 This program is free software, you can redistribute it and/or modify it under
 829 the same terms as Perl itself.
 830
 831 =cut
 832
 833 1;