File Coverage

blib/lib/Language/P/ParseTree/DumpYAML.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Language::P::ParseTree::DumpYAML;
2              
3 49     49   67476 use strict;
  49         123  
  49         2142  
4 49     49   307 use warnings;
  49         122  
  49         2108  
5 49     49   483 use base qw(Language::P::ParseTree::Visitor);
  49         113  
  49         13562  
6              
7 49     49   44108 use YAML qw(Dump Bless);
  0            
  0            
8              
9             my %dispatch =
10             ( 'ARRAY' => '_filter_array',
11             'DEFAULT' => '_filter_fields',
12             );
13              
14             sub method_map { \%dispatch }
15              
16             sub _filter_array {
17             my( $self, $array ) = @_;
18              
19             return [ map { ref( $_ ) ? $self->visit( $_ ) : $_ } @$array ];
20             }
21              
22             sub _filter_fields {
23             my( $self, $tree ) = @_;
24             my @fields = $tree->fields;
25              
26             my $clone = {};
27              
28             foreach my $field ( @fields ) {
29             my $v = $tree->$field;
30             $clone->{$field} = ref( $v ) ? $self->visit( $v ) : $v;
31             }
32              
33             foreach my $attr ( qw(context label) ) {
34             if( $tree->has_attribute( $attr ) ) {
35             $clone->{$attr} = $tree->get_attribute( $attr );
36             }
37             }
38              
39             ( my $tag = ref $tree ) =~ s/^.*::/parsetree:/;
40             Bless( $clone )->tag( $tag );
41              
42             return $clone;
43             }
44              
45             sub dump {
46             my( $self, $tree, $clean ) = @_;
47              
48             if( $clean || 1 ) {
49             my $clone = $self->visit( $tree );
50              
51             return Dump( $clone );
52             } else {
53             return Dump( $tree );
54             }
55             }
56              
57             1;