Fix issue with url encoded links

3 files changed, 19 insertions, 13 deletions

diff --git a/lib/Net/Riak.pm b/lib/Net/Riak.pm
index 7412adb..37a774d 100644
--- a/lib/Net/Riak.pm
+++ b/lib/Net/Riak.pm
@@ -34,7 +34,7 @@ sub bucket {
 =head1 SYNOPSIS
 
     my $client = Net::Riak->new(
-        host => 'http://10.0.0.40:8098', 
+        host => 'http://10.0.0.40:8098',
         ua_timeout => 900
     );
 
diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm
index 1d2b56a..f40031b 100644
--- a/lib/Net/Riak/Object.pm
+++ b/lib/Net/Riak/Object.pm
@@ -64,7 +64,7 @@ sub store {
     if (defined $self->key) {
       push @$path, $self->key;
       $method = 'PUT';
-    } 
+    }
 
     my $request = $self->client->new_request($method, $path, $params);
 
@@ -168,13 +168,13 @@ sub populate {
         shift @siblings;
         $self->siblings(\@siblings);
     }
-    
+
     if ($status == 201) {
         my $location = $http_response->header('location');
         my ($key)    = ($location =~ m!/([^/]+)$!);
         $self->key($key);
-    } 
-    
+    }
+
 
     if ($status == 200 || $status == 201) {
         $self->content_type($http_response->content_type)
@@ -185,16 +185,21 @@ sub populate {
     }
 }
 
+sub _uri_decode {
+  my $str = shift;
+  $str =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
+  return $str;
+}
+
 sub _populate_links {
     my ($self, $links) = @_;
-
     for my $link (split(',', $links)) {
         if ($link
             =~ /\<\/([^\/]+)\/([^\/]+)\/([^\/]+)\>; ?riaktag=\"([^\']+)\"/)
         {
-            my $bucket = $2;
-            my $key    = $3;
-            my $tag    = $4;
+            my $bucket = _uri_decode($2);
+            my $key    = _uri_decode($3);
+            my $tag    = _uri_decode($4);
             my $l      = Net::Riak::Link->new(
                 bucket => Net::Riak::Bucket->new(
                     name   => $bucket,
diff --git a/t/90_bug_links.t b/t/90_bug_links.t
index dd7cc84..f42340e 100644
--- a/t/90_bug_links.t
+++ b/t/90_bug_links.t
@@ -45,7 +45,7 @@ ok my $item = $bucket_two->new_object( '25FCBA57-8D75-41B6-9E5A-0E2528BB3342' =>
 foreach my $person ( $ref1, $ref2 ) {
     my $link = Net::Riak::Link->new(
         bucket => $bucket_one,
-        key    => $person->{username},
+        key    => $person->{email},
         tag    => 'owners'
     );
     ok $item->add_link( $link ), 'link added to object';
@@ -56,10 +56,11 @@ ok $item->store( 1, 1 ), 'object stored';
 
 my $test_links = $bucket_two->get('25FCBA57-8D75-41B6-9E5A-0E2528BB3342', [1]);
 my $links = $test_links->links;
-is $links->[0]->key, 'griffinp', 'good owner for first link';
-is $links->[1]->key, 'griffins', 'good owner for second link';
+is $links->[0]->key, 'peter@familyguy.com', 'good owner for first link';
+is $links->[1]->key, 'stewie@familyguy.com', 'good owner for second link';
 
 $test_links->remove_link($links->[0]);
 $links = $test_links->links;
-is $links->[0]->key, 'griffins', 'good owner for second link after a remove link';
+is $links->[0]->key, 'stewie@familyguy.com', 'good owner for second link after a remove link';
+
 done_testing;