X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FData%2FQuery%2FExprHelpers.pm;h=a48f687c3ed4b05f49511b9ffadf9cbbcddac543;hb=fd6e1f4c94fdfd83ea55b28e9289d5fb14fdb149;hp=b6df568a3a647f207d2f247f807db983d5b70550;hpb=944c72bcfdce01071f01f0179ebbf3b99630d5a1;p=dbsrgits%2FData-Query.git diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm index b6df568..a48f687 100644 --- 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;