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.008';
5 38     38   241 use strict;
  38         78  
  38         1082  
6 38     38   184 use warnings;
  38         74  
  38         1061  
7              
8 38     38   191 use List::Util qw/any sum/;
  38         65  
  38         3679  
9 38     38   252 use Exporter "import";
  38         78  
  38         13605  
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   42 my ($tree, $indent, $offset) = @_;
20 30   50     47 $indent //= "";
21 30   100     51 $offset //= " ";
22              
23 30 50       48 ref $tree eq 'HASH'
24             or die "Bad token object: $tree";
25              
26             my $head = $tree->{
27 30 100       58 $tree->{'type'} eq 'lexeme'
28             ? 'value'
29             : 'name'
30             };
31              
32             my @tail = $tree->{'type'} eq 'lexeme'
33             ? ()
34 30 100       48 : @{ $tree->{'children'} };
  22         33  
35              
36 30 100   20   102 if ( any { ref $_ } @tail ) {
  20         36  
37 20 50       29 my @rest = map { ref $_ ? _dump_tree_inner($_, "$indent$offset", $offset) : "$indent$offset'$_'" } @tail;
  28         93  
38              
39 20         29 my @clean = map { s/^\s+//r } @rest;
  112         210  
40 20 100       69 if (sum(map length, @clean) < 40) {
41 4         10 my @items = ($head, @clean);
42 4         23 return ("$indent(@items)");
43             }
44              
45 16         32 $rest[-1] .= ")";
46 16         99 return ("$indent($head", @rest);
47             } else {
48 10         14 my @tailq = map "'$_'", @tail;
49 10         18 my @items = ($head, @tailq);
50 10         48 return ("$indent(@items)");
51             }
52             }
53              
54             1;
55              
56             __END__