File Coverage

blib/lib/Text/Tree/Indented.pm
Criterion Covered Total %
statement 43 43 100.0
branch 12 12 100.0
condition 4 4 100.0
subroutine 9 9 100.0
pod 1 1 100.0
total 69 69 100.0


line stmt bran cond sub pod time code
1             package Text::Tree::Indented;
2             $Text::Tree::Indented::VERSION = '0.02';
3 3     3   138592 use 5.010;
  3         32  
4 3     3   16 use strict;
  3         4  
  3         77  
5 3     3   15 use warnings;
  3         6  
  3         113  
6 3     3   18 use Carp qw/ croak /;
  3         8  
  3         219  
7 3     3   1581 use Ref::Util 0.202 qw/ is_arrayref /;
  3         5094  
  3         213  
8 3     3   1408 use parent qw/ Exporter /;
  3         929  
  3         19  
9 3     3   1361 use utf8;
  3         33  
  3         16  
10              
11             our @EXPORT_OK = qw/ generate_tree /;
12              
13             my %arguments = (
14             style => "styling of tree, one of: classic, boxrule, norule",
15             );
16              
17             my %styles = (
18             boxrule => { vert => '│', horiz => '─', tee => '├', corner => '└' },
19             classic => { vert => '|', horiz => '-', tee => '+', corner => '+' },
20             norule => { vert => ' ', horiz => ' ', tee => ' ', corner => ' ' },
21             );
22              
23             sub generate_tree
24             {
25 19     19 1 10620 my ($tree, $opt) = @_;
26              
27 19   100     59 $opt //= {};
28 19   100     54 $opt->{style} //= 'boxrule';
29              
30 19         60 foreach my $arg (keys %$opt) {
31 19 100       173 croak "unknown argument '$arg'" if not exists $arguments{$arg};
32             }
33              
34 18 100       248 croak "unknown style '$opt->{style}'" if not exists($styles{ $opt->{style} });
35              
36 17         30 my $render = '';
37              
38 17         28 foreach my $entry (@$tree) {
39 34 100       62 if (is_arrayref($entry)) {
40 11         28 _render_subtree($entry, \$render, $opt, " ");
41             }
42             else {
43 23         53 $render .= $entry."\n";
44             }
45             }
46              
47 17         42 return $render;
48             }
49              
50             sub _render_subtree
51             {
52 26     26   58 my ($subtree, $textref, $opt, $indent) = @_;
53 26         50 my $chars = $styles{ $opt->{style} };
54 26         49 my @nodes = @$subtree;
55              
56 26         56 while (@nodes > 0) {
57 55         94 my $node = shift @nodes;
58 55         87 my $last_node = 0 == int(grep { !is_arrayref($_) } @nodes);
  47         101  
59 55 100       86 if (is_arrayref($node)) {
60 15 100       50 _render_subtree($node, $textref, $opt, $indent.($last_node ? " " : "$chars->{vert} "));
61             }
62             else {
63 40 100       88 my $prefix = ($last_node ? $chars->{corner} : $chars->{tee}).$chars->{horiz};
64 40         144 $$textref .= $indent . $prefix . $node . "\n";
65             }
66             }
67             }
68              
69             1;
70              
71             =encoding utf8
72              
73             =head1 NAME
74              
75             Text::Tree::Indented - render a tree data structure in the classic indented view
76              
77             =head1 SYNOPSIS
78              
79             use Text::Tree::Indented qw/ generate_tree /;
80              
81             my $data = [ 'ABC', [
82             'DEF', [ 'GHI', 'JKL' ],
83             'MNO', [ 'PQR', ['STU' ]],
84             'VWX'
85             ] ];
86              
87             binmode(STDOUT, "utf8");
88             print generate_tree($data);
89              
90             which produces
91              
92             ABC
93             ├─DEF
94             │ ├─GHI
95             │ └─JKL
96             ├─MNO
97             │ └─PQR
98             │ └─STU
99             └─VWX
100              
101             =head1 DESCRIPTION
102              
103             This module provides a single function, C,
104             which takes a perl data structure and renders it into
105             an indented tree view.
106              
107             B: the design of this module is still very much in flux,
108             so the data structure and other aspects may change from release
109             to release.
110              
111             The tree data is passed as an arrayref.
112             A string in the arrayref represents a node in the tree;
113             if it's followed by an arrayref, that's a subtree.
114             So let's say the root of your tree is B,
115             and it has three children, B, B, and B,
116             then the data would look like this:
117              
118             my $tree = ['Fruit', ['Apples', 'Bananas', 'Oranges'] ];
119              
120             This results in the following tree:
121              
122             Fruit
123             ├─Apples
124             ├─Bananas
125             └─Oranges
126              
127             Now you want to add in Red Bananas and Williams Bananas,
128             so your data becomes:
129              
130             my $tree = ['Fruit', ['Apples', 'Bananas', ['Red', 'Williams'], 'Oranges'] ];
131              
132             And now the tree looks like this:
133              
134             Fruit
135             ├─Apples
136             ├─Bananas
137             │ ├─Red
138             │ └─Williams
139             └─Oranges
140              
141             =head2 generate_tree( $data, $options )
142              
143             In addition to the tree data,
144             this function takes an optional second argument,
145             which should be a hashref.
146              
147             At the moment there is just one option, B