X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FDispatcher.pm;h=9ac35815c26fbc7f2996f0d6507efe47dfad5948;hp=fb1efea6000f4c9e7236b2b7716d002527bf910a;hb=88e5a8b0c4d28e46b8ba6b6b9567063e57af9063;hpb=949f330d1f0f7d5fc868ddeb6f338733a2dfa39f

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index fb1efea..9ac3581 100644
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -13,7 +13,8 @@ use Catalyst::DispatchType::Index;
 use Catalyst::Utils;
 use Text::SimpleTable;
 use Tree::Simple;
-use Tree::Simple::Visitor::FindByPath;
+use Class::Load qw(load_class try_load_class);
+use Encode 2.21 'decode_utf8';
 
 use namespace::clean -except => 'meta';
 
@@ -22,7 +23,7 @@ use namespace::clean -except => 'meta';
 # See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
 
 # Preload these action types
-our @PRELOAD = qw/Index Path Regex/;
+our @PRELOAD = qw/Index Path/;
 
 # Postload these action types
 our @POSTLOAD = qw/Default/;
@@ -107,6 +108,9 @@ sub dispatch {
     }
     else {
         my $path  = $c->req->path;
+        $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        $path = decode_utf8($path);
+
         my $error = $path
           ? qq/Unknown resource "$path"/
           : "No default action defined";
@@ -234,7 +238,7 @@ Documented in L<Catalyst>
 sub forward {
     my $self = shift;
     no warnings 'recursion';
-    $self->_do_forward(forward => @_);
+    return $self->_do_forward(forward => @_);
 }
 
 sub _do_forward {
@@ -256,6 +260,12 @@ sub _do_forward {
     no warnings 'recursion';
     $action->dispatch( $c );
 
+    #If there is an error, all bets off regarding state.  Documentation
+    #Specifies that when you forward, if there's an error you must expect
+    #state to be 0.
+    if( @{ $c->error }) {
+      $c->state(0);
+    }
     return $c->state;
 }
 
@@ -268,6 +278,7 @@ Documented in L<Catalyst>
 sub detach {
     my ( $self, $c, $command, @args ) = @_;
     $self->_do_forward(detach => $c, $command, @args ) if $command;
+    $c->state(0); # Needed in order to skip any auto functions
     Catalyst::Exception::Detach->throw;
 }
 
@@ -384,16 +395,25 @@ sub prepare_action {
 
     s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
 
-    $c->log->debug( 'Path is "' . $req->match . '"' )
-      if ( $c->debug && defined $req->match && length $req->match );
+    if($c->debug && defined $req->match && length $req->match) {
+      my $match = $req->match;
+      $match =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+      $match = decode_utf8($match);
+      $c->log->debug( 'Path is "' . $match . '"' )
+    }
 
-    $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+    $c->log->debug( 'Arguments are "' . join( '/', map { decode_utf8 $_ } @args ) . '"' )
       if ( $c->debug && @args );
 }
 
-=head2 $self->get_action( $action, $namespace )
+=head2 $self->get_action( $action_name, $namespace )
+
+returns a named action from a given namespace.  C<$action_name>
+may be a relative path on that C<$namespace> such as
+
+    $self->get_action('../bar', 'foo/baz');
 
-returns a named action from a given namespace.
+In which case we look for the action at 'foo/bar'.
 
 =cut
 
@@ -403,17 +423,22 @@ sub get_action {
 
     $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
 
-    return $self->_action_hash->{"${namespace}/${name}"};
+    return $self->get_action_by_path("${namespace}/${name}");
 }
 
 =head2 $self->get_action_by_path( $path );
 
 Returns the named action by its full private path.
 
+This method performs some normalization on C<$path> so that if
+it includes '..' it will do the right thing (for example if
+C<$path> is '/foo/../bar' that is normalized to '/bar'.
+
 =cut
 
 sub get_action_by_path {
     my ( $self, $path ) = @_;
+    $path =~s/[^\/]+\/\.\.\/// while $path=~m/[^\/]+\/\.\.\//;
     $path =~ s/^\///;
     $path = "/$path" unless $path =~ /\//;
     $self->_action_hash->{$path};
@@ -516,8 +541,11 @@ sub register {
         unless ( $registered->{$class} ) {
             # FIXME - Some error checking and re-throwing needed here, as
             #         we eat exceptions loading dispatch types.
-            eval { Class::MOP::load_class($class) };
-            push( @{ $self->dispatch_types }, $class->new ) unless $@;
+            # see also try_load_class
+            eval { load_class($class) };
+            my $load_failed = $@;
+            $self->_check_deprecated_dispatch_type( $key, $load_failed );
+            push( @{ $self->dispatch_types }, $class->new ) unless $load_failed;
             $registered->{$class} = 1;
         }
     }
@@ -601,7 +629,8 @@ sub setup_actions {
       $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
     @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
 
-    foreach my $comp ( values %{ $c->components } ) {
+    foreach my $comp ( map @{$_}{sort keys %$_}, $c->components ) {
+        $comp = $comp->() if ref($comp) eq 'CODE';
         $comp->register_actions($c) if $comp->can('register_actions');
     }
 
@@ -658,9 +687,8 @@ sub _load_dispatch_types {
         # first param is undef because we cannot get the appclass
         my $class = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $type);
 
-        eval { Class::MOP::load_class($class) };
-        Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
-          if $@;
+        my ($success, $error) = try_load_class($class);
+        Catalyst::Exception->throw( message => $error ) if not $success;
         push @{ $self->dispatch_types }, $class->new;
 
         push @loaded, $class;
@@ -689,6 +717,28 @@ sub dispatch_type {
     return undef;
 }
 
+sub _check_deprecated_dispatch_type {
+    my ($self, $key, $load_failed) = @_;
+
+    return unless $key =~ /^(Local)?Regexp?/;
+
+    # TODO: Should these throw an exception rather than just warning?
+    if ($load_failed) {
+        warn(   "Attempt to use deprecated $key dispatch type.\n"
+              . "  Use Chained methods or install the standalone\n"
+              . "  Catalyst::DispatchType::Regex if necessary.\n" );
+    } elsif ( !defined $Catalyst::DispatchType::Regex::VERSION
+        || $Catalyst::DispatchType::Regex::VERSION le '5.90020' ) {
+        # We loaded the old core version of the Regex module this will break
+        warn(   "The $key DispatchType has been removed from Catalyst core.\n"
+              . "  An old version of the core Catalyst::DispatchType::Regex\n"
+              . "  has been loaded and will likely fail. Please remove\n"
+              . "   $INC{'Catalyst/DispatchType/Regex.pm'}\n"
+              . "  and use Chained methods or install the standalone\n"
+              . "  Catalyst::DispatchType::Regex if necessary.\n" );
+    }
+}
+
 use Moose;
 
 # 5.70 backwards compatibility hacks.