| Subject: | Filters not applied recursively |
The new filter functionality (which is great) is not applied
recursively. This makes it more awkward than it should be to apply
filters to recursive structures (like trees). The attached code
illustrates the issue.
The output is:
# case 1: dump()
bless({
args => [
bless({ name => "A" }, "Leaf"),
bless({
args => [
bless({ name => "B" }, "Leaf"),
bless({ name => "C" }, "Leaf"),
],
op => "OR",
}, "Branch"),
],
op => "AND",
}, "Branch")
# case 2: dumpf() using object => ...
[
"AND",
bless({ name => "A" }, "Leaf"),
bless({
args => [
bless({ name => "B" }, "Leaf"),
bless({ name => "C" }, "Leaf"),
],
op => "OR",
}, "Branch"),
]
# case 3: dump() using add_dump_filter()
[
"AND",
bless({ name => "A" }, "Leaf"),
bless({
args => [
bless({ name => "B" }, "Leaf"),
bless({ name => "C" }, "Leaf"),
],
op => "OR",
}, "Branch"),
]
# case 4: dumpf() using dump => dumpf ...
["AND", "A", ["OR", "B", "C"]]
Case 1 is a plain dump(). I believe that cases 2 and 3 should produce
the same output as case 4, but instead the filter is only applied at the
root level of the structure. I have to explicitly recurse from within
the filter to get the desired output in case 4.
| Subject: | dumptest.pl |
use 5.010;
use strict;
use warnings;
package Branch;
sub new {
my $class = shift;
return bless { op => shift, args => [@_] }, $class;
}
sub op { $_[0]->{op} }
sub args { @{$_[0]->{args}} }
package Leaf;
sub new {
my $class = shift;
return bless { name => shift }, $class;
}
sub name { $_[0]->{name} }
package main;
use Data::Dump qw(dump dumpf);
use Data::Dump::Filtered;
my $tree = Branch->new('AND',
Leaf->new('A'),
Branch->new('OR',
Leaf->new('B'),
Leaf->new('C'),
),
);
say '# case 1: dump()';
say dump $tree;
say '';
say '# case 2: dumpf() using object => ...';
say dumpf $tree, \&f1;
say '';
say '# case 3: dump() using add_dump_filter()';
Data::Dump::Filtered::add_dump_filter(\&f1);
say dump $tree;
say '';
say '# case 4: dumpf() using dump => dumpf ...';
say dumpf $tree, \&f2;
sub f1 {
my ($context, $ref) = @_;
given ($context->class) {
when ('Leaf') {
return { object => $ref->name };
};
when ('Branch') {
return { object => [$ref->op, $ref->args] };
};
default {
return;
};
}
}
sub f2 {
my ($context, $ref) = @_;
given ($context->class) {
when ('Leaf') {
return { object => $ref->name };
};
when ('Branch') {
return { dump => dumpf([$ref->op, $ref->args], \&f2) };
};
default {
return;
};
}
}