File Coverage

blib/lib/Code/Includable/Tree/FromObjArray.pm
Criterion Covered Total %
statement 18 18 100.0
branch 3 4 75.0
condition 5 11 45.4
subroutine 3 3 100.0
pod 0 1 0.0
total 29 37 78.3


line stmt bran cond sub pod time code
1             package Code::Includable::Tree::FromObjArray;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-05-06'; # DATE
5             our $DIST = 'Role-TinyCommons-Tree'; # DIST
6             our $VERSION = '0.126'; # VERSION
7              
8 1     1   447 use strict;
  1         2  
  1         206  
9             our $GET_PARENT_METHOD = 'parent';
10             our $GET_CHILDREN_METHOD = 'children';
11             our $SET_PARENT_METHOD = 'parent';
12             our $SET_CHILDREN_METHOD = 'children';
13              
14             sub __build_subtree {
15 3   50 3   4 my ($parent_node, @obj_array) = ($_[0], @{$_[1] // []});
  3         11  
16              
17 3         5 my @children;
18 3         6 while (@obj_array) {
19 4         7 my $child_node = shift @obj_array;
20              
21             # connect child node to its parent
22 4         11 $child_node->$SET_PARENT_METHOD($parent_node);
23 4         18 push @children, $child_node;
24              
25             # the child has its own children, recurse
26 4 100 66     16 if (@obj_array && ref $obj_array[0] eq 'ARRAY') {
27 2         10 __build_subtree($child_node, shift(@obj_array));
28             }
29             }
30              
31             # connect parent node to its children
32 3         10 $parent_node->$SET_CHILDREN_METHOD(\@children);
33              
34             # return something useful
35 3         15 $parent_node;
36             }
37              
38             sub new_from_obj_array {
39 1     1 0 4971 my $class = shift;
40 1         3 my $obj_array = shift;
41              
42 1 50 33     13 die "Object array must be a one- or two-element array"
      33        
43             unless ref $obj_array eq 'ARRAY' && (@$obj_array == 1 || @$obj_array == 2);
44 1         5 __build_subtree(@$obj_array);
45             }
46              
47             1;
48             # ABSTRACT: Routine to build a tree of objects from a nested array of objects
49              
50             __END__