fix unicode in chain and path parts + debug console
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Dispatcher.pm
index 3a97c87..12040b2 100644 (file)
@@ -14,6 +14,8 @@ 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,29 +24,26 @@ 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/;
 
 # Note - see back-compat methods at end of file.
 has _tree => (is => 'rw', builder => '_build__tree');
-has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
+has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
 
-has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
-
-# Wrap accessors so you can assign a list and it will capture a list ref.
-around qw/preload_dispatch_types postload_dispatch_types/ => sub {
-    my $orig = shift;
-    my $self = shift;
-    return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
-    return $self->$orig(@_);
-};
+my %dispatch_types = ( pre => \@PRELOAD, post => \@POSTLOAD );
+foreach my $type (keys %dispatch_types) {
+    has $type . "load_dispatch_types" => (
+        is => 'rw', required => 1, lazy => 1, default => sub { $dispatch_types{$type} },
+        traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'], # List assignment is CAF style
+    );
+}
 
 =head1 NAME
 
@@ -110,6 +109,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";
@@ -134,7 +136,7 @@ sub _command2action {
     my (@args, @captures);
 
     if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
-        @captures = @{ pop @extra_params };
+        @captures = @{ splice @extra_params, -2, 1 };
     }
 
     if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
@@ -156,7 +158,7 @@ sub _command2action {
         $action = $self->_invoke_as_path( $c, "$command", \@args );
     }
 
-    # go to a component ( "MyApp::*::Foo" or $c->component("...")
+    # go to a component ( "View::Foo" or $c->component("...")
     # - a path or an object)
     unless ($action) {
         my $method = @extra_params ? $extra_params[0] : "process";
@@ -225,7 +227,7 @@ Documented in L<Catalyst>
 sub go {
     my $self = shift;
     $self->_do_visit('go', @_);
-    die $Catalyst::GO;
+    Catalyst::Exception::Go->throw;
 }
 
 =head2 $self->forward( $c, $command [, \@arguments ] )
@@ -271,7 +273,7 @@ Documented in L<Catalyst>
 sub detach {
     my ( $self, $c, $command, @args ) = @_;
     $self->_do_forward(detach => $c, $command, @args ) if $command;
-    die $Catalyst::DETACH;
+    Catalyst::Exception::Detach->throw;
 }
 
 sub _action_rel2abs {
@@ -338,7 +340,7 @@ sub _invoke_as_component {
                 reverse   => "$component_class->$method",
                 class     => $component_class,
                 namespace => Catalyst::Utils::class2prefix(
-                    $component_class, $c->config->{case_sensitive}
+                    $component_class, ref($c)->config->{case_sensitive}
                 ),
             }
         );
@@ -370,14 +372,12 @@ sub prepare_action {
 
   DESCEND: while (@path) {
         $path = join '/', @path;
-        $path =~ s#^/##;
-
-        $path = '' if $path eq '/';    # Root action
+        $path =~ s#^/+##;
 
         # Check out dispatch types to see if any will handle the path at
         # this level
 
-        foreach my $type ( @{ $self->_dispatch_types } ) {
+        foreach my $type ( @{ $self->dispatch_types } ) {
             last DESCEND if $type->match( $c, $path );
         }
 
@@ -389,10 +389,14 @@ 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 );
 }
 
@@ -459,9 +463,6 @@ sub get_containers {
     }
 
     return reverse grep { defined } @containers, $self->_container_hash->{''};
-
-    #return (split '/', $namespace); # isnt this more clear?
-    my @parts = split '/', $namespace;
 }
 
 =head2 $self->uri_for_action($action, \@captures)
@@ -478,7 +479,7 @@ cannot determine an appropriate URI, this method will return undef.
 sub uri_for_action {
     my ( $self, $action, $captures) = @_;
     $captures ||= [];
-    foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
+    foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
         my $uri = $dispatch_type->uri_for_action( $action, $captures );
         return( $uri eq '' ? '/' : $uri )
             if defined($uri);
@@ -497,7 +498,7 @@ single action.
 sub expand_action {
     my ($self, $action) = @_;
 
-    foreach my $dispatch_type (@{ $self->_dispatch_types }) {
+    foreach my $dispatch_type (@{ $self->dispatch_types }) {
         my $expanded = $dispatch_type->expand_action($action);
         return $expanded if $expanded;
     }
@@ -518,22 +519,43 @@ sub register {
 
     my $registered = $self->_registered_dispatch_types;
 
-    #my $priv = 0; #seems to be unused
     foreach my $key ( keys %{ $action->attributes } ) {
         next if $key eq 'Private';
         my $class = "Catalyst::DispatchType::$key";
         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;
         }
     }
 
+    my @dtypes = @{ $self->dispatch_types };
+    my @normal_dtypes;
+    my @low_precedence_dtypes;
+
+    for my $type ( @dtypes ) {
+        if ($type->_is_low_precedence) {
+            push @low_precedence_dtypes, $type;
+        } else {
+            push @normal_dtypes, $type;
+        }
+    }
+
     # Pass the action to our dispatch types so they can register it if reqd.
-    foreach my $type ( @{ $self->_dispatch_types } ) {
-        $type->register( $c, $action );
+    my $was_registered = 0;
+    foreach my $type ( @normal_dtypes ) {
+        $was_registered = 1 if $type->register( $c, $action );
+    }
+
+    if (not $was_registered) {
+        foreach my $type ( @low_precedence_dtypes ) {
+            $type->register( $c, $action );
+        }
     }
 
     my $namespace = $action->namespace;
@@ -578,8 +600,8 @@ sub _find_or_create_namespace_node {
 
 =head2 $self->setup_actions( $class, $context )
 
-Loads all of the preload dispatch types, registers their actions and then
-loads all of the postload dispatch types, and iterates over the tree of
+Loads all of the pre-load dispatch types, registers their actions and then
+loads all of the post-load dispatch types, and iterates over the tree of
 actions, displaying the debug information if appropriate.
 
 =cut
@@ -604,9 +626,12 @@ sub setup_actions {
 sub _display_action_tables {
     my ($self, $c) = @_;
 
-    my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
+    my $avail_width = Catalyst::Utils::term_width() - 12;
+    my $col1_width = ($avail_width * .25) < 20 ? 20 : int($avail_width * .25);
+    my $col2_width = ($avail_width * .50) < 36 ? 36 : int($avail_width * .50);
+    my $col3_width =  $avail_width - $col1_width - $col2_width;
     my $privates = Text::SimpleTable->new(
-        [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
+        [ $col1_width, 'Private' ], [ $col2_width, 'Class' ], [ $col3_width, 'Method' ]
     );
 
     my $has_private = 0;
@@ -633,23 +658,21 @@ sub _display_action_tables {
       if $has_private;
 
     # List all public actions
-    $_->list($c) for @{ $self->_dispatch_types };
+    $_->list($c) for @{ $self->dispatch_types };
 }
 
 sub _load_dispatch_types {
     my ( $self, @types ) = @_;
 
     my @loaded;
-
     # Preload action types
     for my $type (@types) {
-        my $class =
-          ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
+        # 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 $@;
-        push @{ $self->_dispatch_types }, $class->new;
+        my ($success, $error) = try_load_class($class);
+        Catalyst::Exception->throw( message => $error ) if not $success;
+        push @{ $self->dispatch_types }, $class->new;
 
         push @loaded, $class;
     }
@@ -668,16 +691,37 @@ of course it's being used.)
 sub dispatch_type {
     my ($self, $name) = @_;
 
-    unless ($name =~ s/^\+//) {
-        $name = "Catalyst::DispatchType::" . $name;
-    }
+    # first param is undef because we cannot get the appclass
+    $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name);
 
-    for (@{ $self->_dispatch_types }) {
+    for (@{ $self->dispatch_types }) {
         return $_ if ref($_) eq $name;
     }
     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.
@@ -685,16 +729,31 @@ use Moose;
 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
 # need the methods here which *should* be private..
 
-# However we can't really take them away until there is a sane API for
-# building actions and configuring / introspecting the dispatcher.
-# In 5.90, we should build that infrastructure, port the plugins which
-# use it, and then take the crap below away.
+# You should be able to use get_actions or get_containers appropriately
+# instead of relying on these methods which expose implementation details
+# of the dispatcher..
+#
+# IRC backlog included below, please come ask if this doesn't work for you.
+#
+# <@t0m> 5.80, the state of. There are things in the dispatcher which have
+#        been deprecated, that we yell at anyone for using, which there isn't
+#        a good alternative for yet..
+# <@mst> er, get_actions/get_containers provides that doesn't it?
+# <@mst> DispatchTypes are loaded on demand anyway
+# <@t0m> I'm thinking of things like _tree which is aliased to 'tree' with
+#        warnings otherwise shit breaks.. We're issuing warnings about the
+#        correct set of things which you shouldn't be calling..
+# <@mst> right
+# <@mst> basically, I don't see there's a need for a replacement for anything
+# <@mst> it was never a good idea to call ->tree
+# <@mst> nothingmuch was the only one who did AFAIK
+# <@mst> and he admitted it was a hack ;)
+
 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
 
 # Alias _method_name to method_name, add a before modifier to warn..
 foreach my $public_method_name (qw/
         tree
-        dispatch_types
         registered_dispatch_types
         method_action_class
         action_hash
@@ -712,7 +771,7 @@ foreach my $public_method_name (qw/
             $package_hash{$class}++ || do {
                 warn("Class $class is calling the deprecated method\n"
                     . "  Catalyst::Dispatcher::$public_method_name,\n"
-                    . "  this will be removed in Catalyst 5.9X\n");
+                    . "  this will be removed in Catalyst 5.9\n");
             };
         });
     }