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

package Code::Includable::Tree::FromObjArray;

use strict;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-10-07'; # DATE
our $DIST = 'Role-TinyCommons-Tree'; # DIST
our $VERSION = '0.128'; # VERSION

our $GET_PARENT_METHOD = 'parent';
our $GET_CHILDREN_METHOD = 'children';
our $SET_PARENT_METHOD = 'parent';
our $SET_CHILDREN_METHOD = 'children';

sub __build_subtree {
    my ($parent_node, @obj_array) = ($_[0], @{$_[1] // []});

    my @children;
    while (@obj_array) {
        my $child_node = shift @obj_array;

        # connect child node to its parent
        $child_node->$SET_PARENT_METHOD($parent_node);
        push @children, $child_node;

        # the child has its own children, recurse
        if (@obj_array && ref $obj_array[0] eq 'ARRAY') {
            __build_subtree($child_node, shift(@obj_array));
        }
    }

    # connect parent node to its children
    $parent_node->$SET_CHILDREN_METHOD(\@children);

    # return something useful
    $parent_node;
}

sub new_from_obj_array {
    my $class = shift;
    my $obj_array = shift;

    die "Object array must be a one- or two-element array"
        unless ref $obj_array eq 'ARRAY' && (@$obj_array == 1 || @$obj_array == 2);
    __build_subtree(@$obj_array);
}

1;
# ABSTRACT: Routine to build a tree of objects from a nested array of objects

__END__