File Coverage

blib/lib/Text/Tree/Indented.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 10 100.0
condition 2 4 50.0
subroutine 9 9 100.0
pod 1 1 100.0
total 63 65 96.9


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