File Coverage

blib/lib/Code/Includable/Tree/FromStruct.pm

Criterion	Covered	Total	%
statement	28	31	90.3
branch	10	14	71.4
condition	4	5	80.0
subroutine	2	2	100.0
pod	0	1	0.0
total	44	53	83.0

package Code::Includable::Tree::FromStruct;

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

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

sub new_from_struct {
    my $class = shift;
    my $struct = shift;

    my $wanted_class = $struct->{_class} || $class;

    # options that will be passed to children nodes (although children nodes can
    # override these with their own)
    my $pass_attributes = $struct->{_pass_attributes};
    $pass_attributes = 'hash' if !defined $pass_attributes;
    my $constructor = $struct->{_constructor} || "new";
    my $instantiate = $struct->{_instantiate};

    my %attrs = map { $_ => $struct->{$_} } grep {!/^_/} keys %$struct;

    my $node;
    if ($instantiate) {
        $node = $instantiate->($wanted_class, \%attrs);
    } else {
        if (!$pass_attributes) {
            $node = $wanted_class->$constructor;
            for (keys %attrs) {
                $node->$_($attrs{$_});
            }
        } elsif ($pass_attributes eq 'hash') {
            $node = $wanted_class->$constructor(%attrs);
        } elsif ($pass_attributes eq 'hashref') {
            $node = $wanted_class->$constructor(\%attrs);
        } else {
            die "Invalid _pass_attributes value '$pass_attributes'";
        }
    }

    # connect node to parent
    $node->$SET_PARENT_METHOD($struct->{_parent}) if $struct->{_parent};

    # create children
    if ($struct->{_children}) {
        my @children;
        for my $child_struct (@{ $struct->{_children} }) {
            push @children, new_from_struct(
                $class,
                {
                    # default for children nodes
                    _constructor => $constructor,
                    _pass_attributes => $pass_attributes,
                    _instantiate => $instantiate,

                    %$child_struct,

                    _parent => $node,
                },
            );
        }
        # connect node to children
        $node->$SET_CHILDREN_METHOD(\@children);
    }

    $node;
}

1;
# ABSTRACT: Routine to build tree object from data structure

__END__