make map_descending available as map_dq_tree via ExprHelpers

[dbsrgits/Data-Query.git] / lib / Data / Query / ExprHelpers.pm

diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm
index b6df568..a48f687 100644 (file)
--- a/lib/Data/Query/ExprHelpers.pm
+++ b/lib/Data/Query/ExprHelpers.pm
@@ -7,7 +7,7 @@ use base qw(Exporter);
 
 our @EXPORT = qw(
   perl_scalar_value perl_operator Literal Identifier compose intersperse
-  scan_dq_nodes
+  scan_dq_nodes map_dq_tree
 );
 
 sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i }
@@ -141,4 +141,21 @@ sub scan_dq_nodes {
   }
 }
 
+sub map_dq_tree (&;@) {
+  my ($block, $in) = @_;
+  local $_ = $in;
+  $_ = $block->($_) if ref($_) eq 'HASH';
+  if (ref($_) eq 'REF' and ref($$_) eq 'HASH') {
+    $$_;
+  } elsif (ref($_) eq 'HASH') {
+    my $mapped = $_;
+    local $_;
+    +{ map +($_ => &map_dq_tree($block, $mapped->{$_})), keys %$mapped };
+  } elsif (ref($_) eq 'ARRAY') {
+    [ map &map_dq_tree($block, $_), @$_ ]
+  } else {
+    $_
+  }
+}
+
 1;