X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=7395270c28eb8d0eb6d083ec1e8c6649d653e153;hb=41ba54f7fea28ec4d1a879766c5e47ce5738d6eb;hp=a1ec31353e1192a1fc56dd37d962269cc10a55b2;hpb=fc7ec1d96ee55d1bf42af3abce155ecb717b9e2b;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index a1ec313..7395270 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -3,7 +3,6 @@ package Catalyst::Engine;
 use strict;
 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
 use UNIVERSAL::require;
-use B;
 use Data::Dumper;
 use HTML::Entities;
 use HTTP::Headers;
@@ -38,9 +37,15 @@ See L<Catalyst>.
 
 =head1 DESCRIPTION
 
-=head2 METHODS
+=head1 METHODS
 
-=head3 action
+=over 4
+
+=item $c->action( $name => $coderef, ... )
+
+=item $c->action( $name )
+
+=item $c->action
 
 Add one or more actions.
 
@@ -68,8 +73,7 @@ sub action {
     $_[1] ? ( $action = {@_} ) : ( $action = shift );
     if ( ref $action eq 'HASH' ) {
         while ( my ( $name, $code ) = each %$action ) {
-            my $class  = B::svref_2object($code)->STASH->NAME;
-            my $caller = caller(0);
+            my $class = caller(0);
             if ( $name =~ /^\/(.*)\/$/ ) {
                 my $regex = $1;
                 $self->actions->{compiled}->{qr/$regex/} = $name;
@@ -77,19 +81,18 @@ sub action {
             }
             elsif ( $name =~ /^\?(.*)$/ ) {
                 $name = $1;
-                $name = _prefix( $caller, $name );
+                $name = _prefix( $class, $name );
                 $self->actions->{plain}->{$name} = [ $class, $code ];
             }
             elsif ( $name =~ /^\!\?(.*)$/ ) {
                 $name = $1;
-                $name = _prefix( $caller, $name );
+                $name = _prefix( $class, $name );
                 $name = "\!$name";
                 $self->actions->{plain}->{$name} = [ $class, $code ];
             }
             else { $self->actions->{plain}->{$name} = [ $class, $code ] }
             $self->actions->{reverse}->{"$code"} = $name;
-            $self->log->debug(
-                qq/"$caller" defined "$name" as "$code" from "$class"/)
+            $self->log->debug(qq/"$class" defined "$name" as "$code"/)
               if $self->debug;
         }
     }
@@ -97,9 +100,8 @@ sub action {
         if    ( my $p = $self->actions->{plain}->{$action} ) { return [$p] }
         elsif ( my $r = $self->actions->{regex}->{$action} ) { return [$r] }
         else {
-            while ( my ( $regex, $name ) =
-                each %{ $self->actions->{compiled} } )
-            {
+            for my $regex ( keys %{ $self->actions->{compiled} } ) {
+                my $name = $self->actions->{compiled}->{$regex};
                 if ( $action =~ $regex ) {
                     my @snippets;
                     for my $i ( 1 .. 9 ) {
@@ -107,7 +109,8 @@ sub action {
                         last unless ${$i};
                         push @snippets, ${$i};
                     }
-                    return [ $name, \@snippets ];
+                    return [ $self->actions->{regex}->{$name},
+                        $name, \@snippets ];
                 }
             }
         }
@@ -121,7 +124,8 @@ sub action {
     }
 }
 
-=head3 benchmark
+
+=item $c->benchmark($coderef)
 
 Takes a coderef with arguments and returns elapsed time as float.
 
@@ -139,7 +143,9 @@ sub benchmark {
     return wantarray ? ( $elapsed, @return ) : $elapsed;
 }
 
-=head3 component (comp)
+=item $c->comp($name)
+
+=item $c->component($name)
 
 Get a component object by name.
 
@@ -163,7 +169,11 @@ sub component {
     }
 }
 
-=head3 errors
+=item $c->errors
+
+=item $c->errors($error, ...)
+
+=item $c->errors($arrayref)
 
 Returns an arrayref containing errors messages.
 
@@ -182,7 +192,7 @@ sub errors {
     return $c->{errors};
 }
 
-=head3 finalize
+=item $c->finalize
 
 Finalize request.
 
@@ -190,6 +200,13 @@ Finalize request.
 
 sub finalize {
     my $c = shift;
+
+    if ( my $location = $c->res->redirect ) {
+        $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
+        $c->res->headers->header( Location => $location );
+        $c->res->status(302);
+    }
+
     if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
         $c->res->headers->content_type('text/html');
         my $name = $c->config->{name} || 'Catalyst Application';
@@ -283,18 +300,13 @@ sub finalize {
 </html>
 
     }
-    if ( my $location = $c->res->redirect ) {
-        $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
-        $c->res->headers->header( Location => $location );
-        $c->res->status(302);
-    }
     $c->res->headers->content_length( length $c->res->output );
     my $status = $c->finalize_headers;
     $c->finalize_output;
     return $status;
 }
 
-=head3 finalize_headers
+=item $c->finalize_headers
 
 Finalize headers.
 
@@ -302,7 +314,7 @@ Finalize headers.
 
 sub finalize_headers { }
 
-=head3 finalize_output
+=item $c->finalize_output
 
 Finalize output.
 
@@ -310,7 +322,7 @@ Finalize output.
 
 sub finalize_output { }
 
-=head3 forward
+=item $c->forward($command)
 
 Forward processing to a private/public action or a method from a class.
 If you define a class without method it will default to process().
@@ -340,8 +352,20 @@ sub forward {
         $command = _prefix( $caller, $command );
         $command = "\!$command";
     }
+    elsif ( $command =~ /^\!(.*)$/ ) {
+        my $try    = $1;
+        my $caller = caller(0);
+        my $prefix = _class2prefix($caller);
+        $try = "!$prefix/$command";
+        $command = $try if $c->actions->{plain}->{$try};
+    }
     my ( $class, $code );
     if ( my $action = $c->action($command) ) {
+        if ( $action->[2] ) {
+            $c->log->debug(qq/Couldn't forward "$command" to regex action/)
+              if $c->debug;
+            return 0;
+        }
         ( $class, $code ) = @{ $action->[0] };
     }
     else {
@@ -364,7 +388,7 @@ sub forward {
     return $c->process( $class, $code );
 }
 
-=head3 handler
+=item $c->handler($r)
 
 Handles the request.
 
@@ -378,9 +402,11 @@ sub handler {
     eval {
         my $handler = sub {
             my $c = $class->prepare($r);
-            if ( $c->req->action ) {
+            if ( my $action = $c->action( $c->req->action ) ) {
                 my ( $begin, $end );
-                if ( my $prefix = $c->req->args->[0] ) {
+                my $class  = ${ $action->[0] }[0];
+                my $prefix = _class2prefix($class);
+                if ($prefix) {
                     if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
                         $begin = "\!$prefix/begin";
                     }
@@ -392,6 +418,12 @@ sub handler {
                     }
                     elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
                 }
+                else {
+                    if ( $c->actions->{plain}->{'!begin'} ) {
+                        $begin = '!begin';
+                    }
+                    if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
+                }
                 $c->forward($begin)            if $begin;
                 $c->forward( $c->req->action ) if $c->req->action;
                 $c->forward($end)              if $end;
@@ -400,7 +432,7 @@ sub handler {
                 my $action = $c->req->path;
                 my $error  = $action
                   ? qq/Unknown resource "$action"/
-                  : "Congratulations, you're on Catalyst!";
+                  : "No default action defined";
                 $c->log->error($error) if $c->debug;
                 $c->errors($error);
             }
@@ -423,9 +455,9 @@ sub handler {
     return $status;
 }
 
-=head3 prepare
+=item $c->prepare($r)
 
-Turns the request (Apache, CGI...) into a Catalyst context.
+Turns the engine-specific request (Apache, CGI...) into a Catalyst context.
 
 =cut
 
@@ -457,17 +489,27 @@ sub prepare {
     }
     $c->prepare_request($r);
     $c->prepare_path;
-    my $path = $c->request->path;
-    $c->log->debug(qq/Requested path "$path"/) if $c->debug;
     $c->prepare_cookies;
     $c->prepare_headers;
+    my $method = $c->req->method || '';
+    my $path   = $c->req->path   || '';
+    $c->log->debug(qq/"$method" request for "$path"/) if $c->debug;
     $c->prepare_action;
     $c->prepare_parameters;
+
+    if ( $c->debug && keys %{ $c->req->params } ) {
+        my @params;
+        for my $key ( keys %{ $c->req->params } ) {
+            my $value = $c->req->params->{$key} || '';
+            push @params, "$key=$value";
+        }
+        $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
+    }
     $c->prepare_uploads;
     return $c;
 }
 
-=head3 prepare_action
+=item $c->prepare_action
 
 Prepare action.
 
@@ -479,13 +521,13 @@ sub prepare_action {
     my @path = split /\//, $c->req->path;
     $c->req->args( \my @args );
     while (@path) {
-        my $path = join '/', @path;
+        $path = join '/', @path;
         if ( my $result = $c->action($path) ) {
 
             # It's a regex
             if ($#$result) {
-                my $match    = $result->[0];
-                my @snippets = @{ $result->[1] };
+                my $match    = $result->[1];
+                my @snippets = @{ $result->[2] };
                 $c->log->debug(qq/Requested action "$path" matched "$match"/)
                   if $c->debug;
                 $c->log->debug(
@@ -499,8 +541,6 @@ sub prepare_action {
                 $c->log->debug(qq/Requested action "$path"/) if $c->debug;
             }
             $c->req->match($path);
-            $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
-              if ( $c->debug && @args );
             last;
         }
         unshift @args, pop @path;
@@ -518,9 +558,11 @@ sub prepare_action {
             $c->log->debug('Using default action') if $c->debug;
         }
     }
+    $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+      if ( $c->debug && @args );
 }
 
-=head3 prepare_cookies;
+=item $c->prepare_cookies;
 
 Prepare cookies.
 
@@ -528,7 +570,7 @@ Prepare cookies.
 
 sub prepare_cookies { }
 
-=head3 prepare_headers
+=item $c->prepare_headers
 
 Prepare headers.
 
@@ -536,7 +578,7 @@ Prepare headers.
 
 sub prepare_headers { }
 
-=head3 prepare_parameters
+=item $c->prepare_parameters
 
 Prepare parameters.
 
@@ -544,7 +586,7 @@ Prepare parameters.
 
 sub prepare_parameters { }
 
-=head3 prepare_path
+=item $c->prepare_path
 
 Prepare path and base.
 
@@ -552,7 +594,7 @@ Prepare path and base.
 
 sub prepare_path { }
 
-=head3 prepare_request
+=item $c->prepare_request
 
 Prepare the engine request.
 
@@ -560,7 +602,7 @@ Prepare the engine request.
 
 sub prepare_request { }
 
-=head3 prepare_uploads
+=item $c->prepare_uploads
 
 Prepare uploads.
 
@@ -568,7 +610,7 @@ Prepare uploads.
 
 sub prepare_uploads { }
 
-=head3 process
+=item $c->process($class, $coderef)
 
 Process a coderef in given class and catch exceptions.
 Errors are available via $c->errors.
@@ -600,7 +642,7 @@ sub process {
     return $status;
 }
 
-=head3 remove_action
+=item $c->remove_action($action)
 
 Remove an action.
 
@@ -623,19 +665,23 @@ sub remove_action {
     }
 }
 
-=head3 request (req)
+=item $c->request
+
+=item $c->req
 
 Returns a C<Catalyst::Request> object.
 
     my $req = $c->req;
 
-=head3 response (res)
+=item $c->response
+
+=item $c->res
 
 Returns a C<Catalyst::Response> object.
 
     my $res = $c->res;
 
-=head3 setup
+=item $class->setup
 
 Setup.
 
@@ -652,7 +698,7 @@ sub setup {
     }
 }
 
-=head3 setup_components
+=item $class->setup_components
 
 Setup components.
 
@@ -688,7 +734,7 @@ sub setup_components {
       if $self->debug;
 }
 
-=head3 stash
+=item $c->stash
 
 Returns a hashref containing all your data.
 
@@ -710,13 +756,21 @@ sub stash {
 
 sub _prefix {
     my ( $class, $name ) = @_;
+    my $prefix = _class2prefix($class);
+    $name = "$prefix/$name" if $prefix;
+    return $name;
+}
+
+sub _class2prefix {
+    my $class = shift;
     $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
     my $prefix = lc $1 || '';
     $prefix =~ s/\:\:/_/g;
-    $name = "$prefix/$name" if $prefix;
-    return $name;
+    return $prefix;
 }
 
+=back
+
 =head1 AUTHOR
 
 Sebastian Riedel, C<sri@cpan.org>