X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=641cc6d63ac6e0a0e684da3ec897635896a5ad8d;hb=cd677e12b127597abb93b76560c8cb23a47d5da6;hp=370ff5e012d0bdec323aefa04820dcd2538a3423;hpb=91dc9907365d9a8b25836d3c3bf68683af18eb7d;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 370ff5e..641cc6d 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -7,25 +7,19 @@ use CGI::Cookie;
 use Data::Dumper;
 use HTML::Entities;
 use HTTP::Headers;
-use Memoize;
 use Time::HiRes qw/gettimeofday tv_interval/;
-use Tree::Simple;
-use Tree::Simple::Visitor::FindByPath;
+use Text::ASCIITable;
 use Catalyst::Request;
+use Catalyst::Request::Upload;
 use Catalyst::Response;
 
 require Module::Pluggable::Fast;
 
 $Data::Dumper::Terse = 1;
 
-__PACKAGE__->mk_classdata($_) for qw/actions components tree/;
+__PACKAGE__->mk_classdata('components');
 __PACKAGE__->mk_accessors(qw/request response state/);
 
-__PACKAGE__->actions(
-    { plain => {}, private => {}, regex => {}, compiled => [], reverse => {} }
-);
-__PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
-
 *comp = \&component;
 *req  = \&request;
 *res  = \&response;
@@ -33,8 +27,6 @@ __PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
 our $COUNT = 1;
 our $START = time;
 
-memoize('_class2prefix');
-
 =head1 NAME
 
 Catalyst::Engine - The Catalyst Engine
@@ -136,17 +128,20 @@ sub execute {
             $action = "-> $action" if $callsub =~ /forward$/;
             my ( $elapsed, @state ) =
               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
-            push @{ $c->{stats} },
-              _prettify_stats( $action, sprintf( '%fs', $elapsed ), '' );
+            push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
             $c->state(@state);
         }
         else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
     };
     if ( my $error = $@ ) {
-        chomp $error;
-        $error = qq/Caught exception "$error"/;
+
+        unless ( ref $error ) {
+            chomp $error;
+            $error = qq/Caught exception "$error"/;
+        }
+
         $c->log->error($error);
-        $c->error($error) if $c->debug;
+        $c->error($error);
         $c->state(0);
     }
     return $c->state;
@@ -166,7 +161,7 @@ sub finalize {
     if ( my $location = $c->response->redirect ) {
         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
         $c->response->header( Location => $location );
-        $c->response->status(302) if $c->response->status !~ /3\d\d$/;
+        $c->response->status(302) if $c->response->status !~ /^3\d\d$/;
     }
 
     if ( $#{ $c->error } >= 0 ) {
@@ -329,104 +324,6 @@ Finalize output.
 
 sub finalize_output { }
 
-=item $c->forward($command)
-
-Forward processing to a private action or a method from a class.
-If you define a class without method it will default to process().
-
-    $c->forward('/foo');
-    $c->forward('index');
-    $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
-    $c->forward('MyApp::View::TT');
-
-=cut
-
-sub forward {
-    my $c       = shift;
-    my $command = shift;
-    unless ($command) {
-        $c->log->debug('Nothing to forward to') if $c->debug;
-        return 0;
-    }
-    my $caller    = caller(0);
-    my $namespace = '/';
-    if ( $command =~ /^\// ) {
-        $command =~ /^(.*)\/(\w+)$/;
-        $namespace = $1 || '/';
-        $command = $2;
-    }
-    else { $namespace = _class2prefix($caller) || '/' }
-    my $results = $c->get_action( $command, $namespace );
-    unless ( @{$results} ) {
-        my $class = $command;
-        if ( $class =~ /[^\w\:]/ ) {
-            $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug;
-            return 0;
-        }
-        my $method = shift || 'process';
-        if ( my $code = $class->can($method) ) {
-            $c->actions->{reverse}->{"$code"} = "$class->$method";
-            $results = [ [ [ $class, $code ] ] ];
-        }
-        else {
-            $c->log->debug(qq/Couldn't forward to "$class->$method"/)
-              if $c->debug;
-            return 0;
-        }
-    }
-    for my $result ( @{$results} ) {
-        $c->state( $c->execute( @{ $result->[0] } ) );
-    }
-    return $c->state;
-}
-
-=item $c->get_action( $action, $namespace )
-
-Get an action in a given namespace.
-
-=cut
-
-sub get_action {
-    my ( $c, $action, $namespace ) = @_;
-    $namespace ||= '';
-    if ($namespace) {
-        $namespace = '' if $namespace eq '/';
-        my $parent = $c->tree;
-        my @results;
-        my $result = $c->actions->{private}->{ $parent->getUID }->{$action};
-        push @results, [$result] if $result;
-        my $visitor = Tree::Simple::Visitor::FindByPath->new;
-        for my $part ( split '/', $namespace ) {
-            $visitor->setSearchPath($part);
-            $parent->accept($visitor);
-            my $child = $visitor->getResult;
-            my $uid   = $child->getUID if $child;
-            my $match = $c->actions->{private}->{$uid}->{$action} if $uid;
-            push @results, [$match] if $match;
-            $parent = $child if $child;
-        }
-        return \@results;
-    }
-    elsif ( my $p = $c->actions->{plain}->{$action} ) { return [ [$p] ] }
-    elsif ( my $r = $c->actions->{regex}->{$action} ) { return [ [$r] ] }
-    else {
-        for my $i ( 0 .. $#{ $c->actions->{compiled} } ) {
-            my $name  = $c->actions->{compiled}->[$i]->[0];
-            my $regex = $c->actions->{compiled}->[$i]->[1];
-            if ( $action =~ $regex ) {
-                my @snippets;
-                for my $i ( 1 .. 9 ) {
-                    no strict 'refs';
-                    last unless ${$i};
-                    push @snippets, ${$i};
-                }
-                return [ [ $c->actions->{regex}->{$name}, $name, \@snippets ] ];
-            }
-        }
-    }
-    return [];
-}
-
 =item $c->handler( $class, $r )
 
 Handles the request.
@@ -443,40 +340,7 @@ sub handler {
         my $handler = sub {
             my $c = $class->prepare($engine);
             $c->{stats} = \@stats;
-            my $action    = $c->req->action;
-            my $namespace = '';
-            $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
-              if $action eq 'default';
-            unless ($namespace) {
-                if ( my $result = $c->get_action($action) ) {
-                    $namespace = _class2prefix( $result->[0]->[0]->[0] );
-                }
-            }
-            my $default = $action eq 'default' ? $namespace : undef;
-            my $results = $c->get_action( $action, $default );
-            $namespace ||= '/';
-            if ( @{$results} ) {
-                for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
-                    $c->state( $c->execute( @{ $begin->[0] } ) );
-                }
-                for my $result ( @{ $c->get_action( $action, $default ) }[-1] )
-                {
-                    $c->state( $c->execute( @{ $result->[0] } ) );
-                    last unless $default;
-                }
-                for my $end ( reverse @{ $c->get_action( 'end', $namespace ) } )
-                {
-                    $c->state( $c->execute( @{ $end->[0] } ) );
-                }
-            }
-            else {
-                my $path  = $c->req->path;
-                my $error = $path
-                  ? qq/Unknown resource "$path"/
-                  : "No default action defined";
-                $c->log->error($error) if $c->debug;
-                $c->error($error);
-            }
+            $c->dispatch;
             return $c->finalize;
         };
         if ( $class->debug ) {
@@ -484,7 +348,14 @@ sub handler {
             ( $elapsed, $status ) = $class->benchmark($handler);
             $elapsed = sprintf '%f', $elapsed;
             my $av = sprintf '%.3f', 1 / $elapsed;
-            $class->log->info( "Request took $elapsed" . "s ($av/s)", @stats );
+            my $t = Text::ASCIITable->new;
+            $t->setCols( 'Action', 'Time' );
+            $t->setColWidth( 'Action', 64, 1 );
+            $t->setColWidth( 'Time',   9,  1 );
+
+            for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
+            $class->log->info( "Request took $elapsed" . "s ($av/s)",
+                $t->draw );
         }
         else { $status = &$handler }
     };
@@ -525,9 +396,9 @@ sub prepare {
     if ( $c->debug ) {
         my $secs = time - $START || 1;
         my $av = sprintf '%.3f', $COUNT / $secs;
-        $c->log->debug('********************************');
+        $c->log->debug('**********************************');
         $c->log->debug("* Request $COUNT ($av/s) [$$]");
-        $c->log->debug('********************************');
+        $c->log->debug('**********************************');
         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
     }
     $c->prepare_request($r);
@@ -545,12 +416,15 @@ sub prepare {
     $c->prepare_parameters;
 
     if ( $c->debug && keys %{ $c->req->params } ) {
-        my @params;
+        my $t = Text::ASCIITable->new;
+        $t->setCols( 'Key', 'Value' );
+        $t->setColWidth( 'Key',   37, 1 );
+        $t->setColWidth( 'Value', 36, 1 );
         for my $key ( keys %{ $c->req->params } ) {
             my $value = $c->req->params->{$key} || '';
-            push @params, "  + $key=$value";
+            $t->addRow( $key, $value );
         }
-        $c->log->debug( 'Parameters are', @params );
+        $c->log->debug( 'Parameters are', $t->draw );
     }
     $c->prepare_uploads;
     return $c;
@@ -575,7 +449,8 @@ sub prepare_action {
             if ($#$result) {
                 my $match    = $result->[1];
                 my @snippets = @{ $result->[2] };
-                $c->log->debug(qq/Requested action "$path" matched "$match"/)
+                $c->log->debug(
+                    qq/Requested action is "$path" and matched "$match"/)
                   if $c->debug;
                 $c->log->debug(
                     'Snippets are "' . join( ' ', @snippets ) . '"' )
@@ -585,7 +460,7 @@ sub prepare_action {
             }
             else {
                 $c->req->action($path);
-                $c->log->debug(qq/Requested action "$path"/) if $c->debug;
+                $c->log->debug(qq/Requested action is "$path"/) if $c->debug;
             }
             $c->req->match($path);
             last;
@@ -686,80 +561,6 @@ Returns a C<Catalyst::Response> object.
 
     my $res = $c->res;
 
-=item $c->set_action( $action, $code, $namespace, $attrs )
-
-Set an action in a given namespace.
-
-=cut
-
-sub set_action {
-    my ( $c, $method, $code, $namespace, $attrs ) = @_;
-
-    my $prefix = _class2prefix($namespace) || '';
-    my %flags;
-
-    for my $attr ( @{$attrs} ) {
-        if    ( $attr =~ /^(Local|Relative)$/ )        { $flags{local}++ }
-        elsif ( $attr =~ /^(Global|Absolute)$/ )       { $flags{global}++ }
-        elsif ( $attr =~ /^Path\((.+)\)$/i )           { $flags{path} = $1 }
-        elsif ( $attr =~ /^Private$/i )                { $flags{private}++ }
-        elsif ( $attr =~ /^(Regex|Regexp)\((.+)\)$/i ) { $flags{regex} = $2 }
-    }
-
-    return unless keys %flags;
-
-    my $parent  = $c->tree;
-    my $visitor = Tree::Simple::Visitor::FindByPath->new;
-    for my $part ( split '/', $prefix ) {
-        $visitor->setSearchPath($part);
-        $parent->accept($visitor);
-        my $child = $visitor->getResult;
-        unless ($child) {
-            $child = $parent->addChild( Tree::Simple->new($part) );
-            $visitor->setSearchPath($part);
-            $parent->accept($visitor);
-            $child = $visitor->getResult;
-        }
-        $parent = $child;
-    }
-    my $uid = $parent->getUID;
-    $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
-    my $forward = $prefix ? "$prefix/$method" : $method;
-
-    if ( $flags{path} ) {
-        $flags{path} =~ s/^\w+//;
-        $flags{path} =~ s/\w+$//;
-        if ( $flags{path} =~ /^'(.*)'$/ ) { $flags{path} = $1 }
-        if ( $flags{path} =~ /^"(.*)"$/ ) { $flags{path} = $1 }
-    }
-    if ( $flags{regex} ) {
-        $flags{regex} =~ s/^\w+//;
-        $flags{regex} =~ s/\w+$//;
-        if ( $flags{regex} =~ /^'(.*)'$/ ) { $flags{regex} = $1 }
-        if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 }
-    }
-
-    my $reverse = $prefix ? "$prefix/$method" : $method;
-
-    if ( $flags{local} || $flags{global} || $flags{path} ) {
-        my $path = $flags{path} || $method;
-        my $absolute = 0;
-        if ( $path =~ /^\/(.+)/ ) {
-            $path     = $1;
-            $absolute = 1;
-        }
-        $absolute = 1 if $flags{global};
-        my $name = $absolute ? $path : "$prefix/$path";
-        $c->actions->{plain}->{$name} = [ $namespace, $code ];
-    }
-    if ( my $regex = $flags{regex} ) {
-        push @{ $c->actions->{compiled} }, [ $regex, qr#$regex# ];
-        $c->actions->{regex}->{$regex} = [ $namespace, $code ];
-    }
-
-    $c->actions->{reverse}->{"$code"} = $reverse;
-}
-
 =item $class->setup
 
 Setup.
@@ -777,41 +578,6 @@ sub setup {
     }
 }
 
-=item $class->setup_actions($component)
-
-Setup actions for a component.
-
-=cut
-
-sub setup_actions {
-    my ( $self, $comp ) = @_;
-    $comp = ref $comp || $comp;
-    for my $action ( @{ $comp->_cache } ) {
-        my ( $code, $attrs ) = @{$action};
-        my $name = '';
-        no strict 'refs';
-        my @cache = ( $comp, @{"$comp\::ISA"} );
-        my %namespaces;
-        while ( my $namespace = shift @cache ) {
-            $namespaces{$namespace}++;
-            for my $isa ( @{"$comp\::ISA"} ) {
-                next if $namespaces{$isa};
-                push @cache, $isa;
-                $namespaces{$isa}++;
-            }
-        }
-        for my $namespace ( keys %namespaces ) {
-            for my $sym ( values %{ $namespace . '::' } ) {
-                if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
-                    $name = *{$sym}{NAME};
-                    $self->set_action( $name, $code, $comp, $attrs );
-                    last;
-                }
-            }
-        }
-    }
-}
-
 =item $class->setup_components
 
 Setup components.
@@ -838,47 +604,25 @@ sub setup_components {
         $self->log->error(
             qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/);
     }
-    $self->setup_actions($self);
     $self->components( {} );
+    my @comps;
     for my $comp ( $self->_components($self) ) {
         $self->components->{ ref $comp } = $comp;
-        $self->setup_actions($comp);
-    }
-    my @comps;
-    push @comps, "  + $_" for keys %{ $self->components };
-    $self->log->debug( 'Loaded components', @comps )
-      if ( @comps && $self->debug );
-    my $actions  = $self->actions;
-    my @messages = ('Loaded private actions');
-    my $walker   = sub {
-        my ( $walker, $parent, $messages, $prefix ) = @_;
-        $prefix .= $parent->getNodeValue || '';
-        $prefix .= '/' unless $prefix =~ /\/$/;
-        my $uid = $parent->getUID;
-        for my $action ( keys %{ $actions->{private}->{$uid} } ) {
-            my ( $class, $code ) = @{ $actions->{private}->{$uid}->{$action} };
-            push @$messages,
-              _prettify_action( "$prefix$action", $class, $code );
-        }
-        $walker->( $walker, $_, $messages, $prefix )
-          for $parent->getAllChildren;
-    };
-    $walker->( $walker, $self->tree, \@messages, '' );
-    $self->log->debug(@messages) if ( $#messages && $self->debug );
-    @messages = ('Loaded plain actions');
-    for my $plain ( sort keys %{ $actions->{plain} } ) {
-        my ( $class, $code ) = @{ $actions->{plain}->{$plain} };
-        push @messages, _prettify_action( "/$plain", $class, $code );
-    }
-    $self->log->debug(@messages) if ( $#messages && $self->debug );
-    @messages = ('Loaded regex actions');
-    for my $regex ( sort keys %{ $actions->{regex} } ) {
-        my ( $class, $code ) = @{ $actions->{regex}->{$regex} };
-        push @messages, _prettify_action( $regex, $class, $code );
-    }
-    $self->log->debug(@messages) if ( $#messages && $self->debug );
+        push @comps, $comp;
+    }
+    my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
+    $t->setCols('Class');
+    $t->setColWidth( 'Class', 75, 1 );
+    $t->addRow($_) for keys %{ $self->components };
+    $self->log->debug( 'Loaded components', $t->draw )
+      if ( @{ $t->{tbl_rows} } && $self->debug );
+    $self->setup_actions( [ $self, @comps ] );
 }
 
+=item $c->state
+
+Contains the return value of the last executed action.
+
 =item $c->stash
 
 Returns a hashref containing all your data.
@@ -899,41 +643,6 @@ sub stash {
     return $self->{stash};
 }
 
-sub _prefix {
-    my ( $class, $name ) = @_;
-    my $prefix = _class2prefix($class);
-    $name = "$prefix/$name" if $prefix;
-    return $name;
-}
-
-sub _class2prefix {
-    my $class = shift || '';
-    my $prefix;
-    if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
-        $prefix = lc $2;
-        $prefix =~ s/\:\:/\//g;
-    }
-    return $prefix;
-}
-
-sub _prettify_action {
-    my ( $val1, $val2, $val3 ) = @_;
-    formline '  + @<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
-      . ' @>>>>>>>>>>>>>>  ', $val1, $val2, $val3;
-    my $formatted = $^A;
-    $^A = '';
-    return $formatted;
-}
-
-sub _prettify_stats {
-    my ( $val1, $val2 ) = @_;
-    formline '  + @<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<< ',
-      $val1, $val2;
-    my $formatted = $^A;
-    $^A = '';
-    return $formatted;
-}
-
 =back
 
 =head1 AUTHOR