get_subtree subroutine

gistfile1.pl

sub get_subtree {
    my ($self, %opt) = @_;
    my (@load, %referents, @top_nodes, @tree, %map, $db, $nodes);

    $nodes = delete $opt{work_chart_nodes};
    $db = $opt{db} || $self->init_db;

    %map = map {
        $_->db( undef );
        $_->children( [] );
        my $p = $_->parent_id;
        $p = '_top_' unless defined $p;
        $referents{$p}{$_->id} = $_;
        $_->id => $_
    } @$nodes;
    @load = grep { !$map{$_} } $self->_parent_ids( @$nodes );
    while (@load) {
        my @generation;
        for my $node (
            @{
                EndPoint::M::WorkChart::Manager->get_objects(
                    db      => $db,
                    query   => [
                        id  => \@load,
                    ],
                )
            }
        ) {
            $node->db( undef );
            $map{$node->id} ||= $node;
            my $parent_id = $node->parent_id;
            if (defined $parent_id) {
                push @generation, $parent_id;
            }
            else {
                $parent_id = '_top_';
            }
            $referents{$parent_id}{$node->id} ||= $node;
        }
        @load = grep { !$map{$_} } @generation;
    }

    @top_nodes = map { %{$referents{$_->id}} ? values %{$referents{$_->id}} : $_ } values %{ $referents{_top_} };
    
    my $walker = sub {
        my ($node, $sub, $level) = @_;
        $level ||= 0;
        return unless my $ref = $referents{$node->id};
        $node->children( values %$ref );
        $sub->($_, $sub, $level + 1) for values %$ref;
        return;
    };

    @tree = map {
        $walker->($_, $walker);
        $_;
    }
    @top_nodes;

    return wantarray ? @tree : \@tree;
}