Merge pull request #397 from LibreCat/pr/fix-empty-paths

Adding support for empty paths

lib/Catmandu/Fix.pm

@@ -859,7 +859,8 @@ or double quotes:
 
 Most of the Fix commands use paths to point to values
 in a data record. E.g. 'foo.2.bar' is a key 'bar' which is the 3-rd value of the
-key 'foo'.
+key 'foo'. E.g. "foo.''" is a an empty string key which is the value of the key
+'foo'.
 
 A special case is when you want to point to all items in an array. In this case
 the wildcard '*' can be used. E.g. 'foo.*' points to all the items in the 'foo'

lib/Catmandu/Path/simple.pm

@@ -201,7 +201,7 @@ sub _emit_get {
     $path = [@$path];
 
     my $key     = shift @$path;
-    my $str_key = $self->_emit_string($key);
+    my $str_key = $self->_emit_string($self->unquote($key));
     my $perl    = "";
 
     %opts = (up_var => my $up_var = $var);
@@ -261,7 +261,7 @@ sub _emit_set_key {
     return "${var} = $val;" unless defined $key;
 
     my $perl    = "";
-    my $str_key = $self->_emit_string($key);
+    my $str_key = $self->_emit_string($self->unquote($key));
 
     if (is_natural($key)) {
         $perl .= "if (is_hash_ref(${var})) {";
@@ -312,7 +312,7 @@ sub _emit_create_path {
     @$path || return $cb->($var);
 
     my $key     = shift @$path;
-    my $str_key = $self->_emit_string($key);
+    my $str_key = $self->_emit_string($self->unquote($key));
     my $perl    = "";
 
     if (is_natural($key)) {
@@ -389,16 +389,16 @@ sub _emit_create_path {
 sub _emit_delete_key {
     my ($self, $var, $key) = @_;
 
-    my $str_key = $self->_emit_string($key);
+    my $str_key = $self->_emit_string($self->unquote($key));
     my $perl    = "";
 
-    if (is_natural($key)) {
+    if (defined($key) && is_natural($key)) {
         $perl .= "if (is_hash_ref(${var}) && exists(${var}->{${str_key}})) {";
         $perl .= "delete(${var}->{${str_key}});";
         $perl .= "} elsif (is_array_ref(${var}) && \@{${var}} > ${key}) {";
         $perl .= "splice(\@{${var}}, ${key}, 1)";
     }
-    elsif ($key eq '$first' || $key eq '$last' || $key eq '*') {
+    elsif (defined($key) && ($key eq '$first' || $key eq '$last' || $key eq '*')) {
         $perl .= "if (is_array_ref(${var}) && \@{${var}}) {";
         $perl .= "splice(\@{${var}}, 0, 1)" if $key eq '$first';
         $perl .= "splice(\@{${var}}, \@{${var}} - 1, 1)" if $key eq '$last';
@@ -414,6 +414,22 @@ sub _emit_delete_key {
     $perl;
 }
 
+sub unquote {
+    my ($self, $str) = @_;
+    if (! defined $str) {
+        return $str;
+    }
+    elsif ($str =~ /^['](.*)[']$/) {
+        return $1;
+    }
+    elsif ($str =~ /^["](.*)["]$/) {
+        return $1;
+    }
+    else {
+        return $str;
+    }
+}
+
 1;
 
 __END__

t/Catmandu-Fix-add_field.t

@@ -32,4 +32,16 @@ is_deeply $pkg->new('test', '0123')->fix({}), {test => '0123'},
 
 is_deeply $pkg->new('test')->fix({}), {test => undef}, "set key to undef";
 
+is_deeply $pkg->new("''", 'empty')->fix({}), {'' => 'empty'},
+    "add an empty field";
+
+is_deeply $pkg->new("'a'", 'test')->fix({}), {a => 'test'},
+    "add a single quoted field";
+
+is_deeply $pkg->new("\"a\"", 'test')->fix({}), {a => 'test'},
+    "add a double quoted field";
+
+is_deeply $pkg->new("\"a b c\"", 'test')->fix({}), {"a b c" => 'test'},
+    "add a double quoted field with spaces";
+
 done_testing;

t/Catmandu-Fix-copy_field.t

@@ -34,4 +34,16 @@ is_deeply $pkg->new('nested', '.')
 is_deeply $pkg->new('nested', '.')->fix({nested => [1, 2, 3], foo => 'bar'}),
     [1, 2, 3], "replace root";
 
+is_deeply $pkg->new("''", 'test')
+    ->fix({ '' => 'foo'}), { '' => 'foo' , test => 'foo' },
+    "copy empty field";
+
+is_deeply $pkg->new("test", "''")
+    ->fix({ test => 'foo'}), { test => 'foo' , '' => 'foo' },
+    "copy to empty field";
+
+is_deeply $pkg->new("test", "x.''")
+    ->fix({ test => 'foo'}), { test => 'foo' , x => {'' => 'foo'} },
+    "copy to nested empty field";
+
 done_testing;

t/Catmandu-Fix-move_field.t

@@ -34,4 +34,16 @@ is_deeply $pkg->new('nested', '.')
 is_deeply $pkg->new('nested', '.')->fix({nested => [1, 2, 3], foo => 'bar'}),
     [1, 2, 3], "replace root";
 
+is_deeply $pkg->new("''", 'test')
+    ->fix({ '' => 'foo'}), { test => 'foo' },
+    "move empty field";
+
+is_deeply $pkg->new("test", "''")
+    ->fix({ test => 'foo'}), { '' => 'foo' },
+    "move to empty field";
+
+is_deeply $pkg->new("test", "x.''")
+    ->fix({ test => 'foo'}), { x => {'' => 'foo'} },
+    "move to nested empty field";
+
 done_testing;

t/Catmandu-Fix-remove_field.t

@@ -24,4 +24,20 @@ is_deeply $pkg->new('many.*.remove')->fix(
     {many => [{keep => 'me'}, {keep => 'me'}]},
     "remove nested field with wildcard";
 
-done_testing 3;
+is_deeply $pkg->new("''")
+    ->fix({a => 'A', '' => 'Empty', c => 'C'}),
+    {a => 'A', c => 'C'}, 'remove empty';
+
+is_deeply $pkg->new("\"\"")
+    ->fix({a => 'A', '' => 'Empty', c => 'C'}),
+    {a => 'A', c => 'C'}, 'remove empty (double quotes)';
+
+is_deeply $pkg->new("x.''")
+    ->fix({ x => {a => 'A', '' => 'Empty', c => 'C'}}),
+    {x => {a => 'A', c => 'C'} }, 'remove nested empty';
+
+is_deeply $pkg->new("\"x y z\"")
+    ->fix({a => 'A', 'x y z' => 'Empty', c => 'C'}),
+    {a => 'A', c => 'C'}, 'remove keys with spaces';
+
+done_testing 7;

t/Catmandu-Fix-set_field.t

@@ -32,4 +32,13 @@ is_deeply $pkg->new('test', '0123')->fix({test => 'ok'}), {test => '0123'},
 
 is_deeply $pkg->new('test')->fix({}), {test => undef}, "set key to undef";
 
+is_deeply $pkg->new("'a'", 'test')->fix({}), {a => 'test'},
+    "add a single quoted field";
+
+is_deeply $pkg->new("\"a\"", 'test')->fix({}), {a => 'test'},
+    "add a double quoted field";
+
+is_deeply $pkg->new("\"a b c\"", 'test')->fix({}), {"a b c" => 'test'},
+    "add a double quoted field with spaces";
+
 done_testing;