File Coverage

blib/lib/Guacamole/Dumper.pm
Criterion Covered Total %
statement 35 35 100.0
branch 10 12 83.3
condition 3 4 75.0
subroutine 7 7 100.0
pod 0 1 0.0
total 55 59 93.2


line stmt bran cond sub pod time code
1             package Guacamole::Dumper;
2             our $AUTHORITY = 'cpan:XSAWYERX';
3             # ABSTRACT: Dump Guacamole ASTs
4             $Guacamole::Dumper::VERSION = '0.006';
5 35     35   302 use strict;
  35         83  
  35         1435  
6 35     35   207 use warnings;
  35         75  
  35         1486  
7              
8 35     35   227 use List::Util qw/any sum/;
  35         78  
  35         5037  
9 35     35   262 use Exporter "import";
  35         79  
  35         16435  
10              
11             our @EXPORT_OK = qw/dump_tree/;
12              
13             sub dump_tree {
14 2     2 0 7 my ($tree, $offset) = @_;
15 2         10 return join "", map "$_\n", _dump_tree_inner($tree, "", $offset);
16             }
17              
18             sub _dump_tree_inner {
19 30     30   60 my ($tree, $indent, $offset) = @_;
20 30   50     59 $indent //= "";
21 30   100     56 $offset //= " ";
22              
23 30 50       76 ref $tree eq 'HASH'
24             or die "Bad token object: $tree";
25              
26             my $head = $tree->{
27 30 100       79 $tree->{'type'} eq 'lexeme'
28             ? 'value'
29             : 'name'
30             };
31              
32             my @tail = $tree->{'type'} eq 'lexeme'
33             ? ()
34 30 100       62 : @{ $tree->{'children'} };
  22         44  
35              
36 30 100   20   121 if ( any { ref $_ } @tail ) {
  20         46  
37 20 50       33 my @rest = map { ref $_ ? _dump_tree_inner($_, "$indent$offset", $offset) : "$indent$offset'$_'" } @tail;
  28         112  
38              
39 20         38 my @clean = map { s/^\s+//r } @rest;
  112         302  
40 20 100       102 if (sum(map length, @clean) < 40) {
41 4         17 my @items = ($head, @clean);
42 4         27 return ("$indent(@items)");
43             }
44              
45 16         36 $rest[-1] .= ")";
46 16         125 return ("$indent($head", @rest);
47             } else {
48 10         19 my @tailq = map "'$_'", @tail;
49 10         21 my @items = ($head, @tailq);
50 10         65 return ("$indent(@items)");
51             }
52             }
53              
54             1;
55              
56             __END__