# by bliako
# for https://perlmonks.org/?node_id=11117492
# date: 30/05/2020
# The tiniest and *most intuitive* Nary Tree package
# to store a grocery

{
package Tree::Nary::Tiny;
use strict;
use warnings;
sub	new {
	my $class = $_[0];
	my $parent = $_[1];
	my $id = $_[2];
	my $value = $_[3];
	my $print_value_sub = $_[4]; # optional
	$print_value_sub = sub { return $_[0] } unless defined $print_value_sub;
	my $self = {
		'_parent' => $parent,
		'id' => $id,
		'v' => $value,
		'pvs' => $print_value_sub,
		'c' => [],
		'_depth' => 0
	};
	bless $self => $class;

	if( defined $parent ){
		push @{$parent->{'c'}}, $self;
		$self->{'_depth'} = $parent->{'_depth'} + 1;
	}
	return $self
}
sub	leaf_nodes {
	my $self = $_[0];
	my @ret;
	for(@{$self->{'c'}}){
		my $aret = $_->leaf_nodes();
		push(@ret, @$aret) if defined $aret;
	}
	return scalar @ret ? \@ret : [$self]
}
sub	parent { return $_[0]->{'_parent'} }
sub	value { return $_[0]->{'v'} }
sub	depth { return $_[0]->{'_depth'} }
sub	id { return $_[0]->{'id'} }
sub	children { return $_[0]->{'c'} }
sub	value_stringify { return $_[0]->{'pvs'}->($_[0]) }
sub	add_child {
	return Tree::Nary::Tiny->new(
		$_[0], # parent is our self
		$_[1], # id
		$_[2], # optional value/data
		# optional print value sub or inherit from parent
		defined($_[3]) ? $_[3] : $_[0]->{'pvs'}
	);
}		
sub	stringify {
	my $self = $_[0];
	my $v = $self->{'v'};
	my $dep = $self->depth();
	my $ret = "   " x $dep . $self->{'id'} . " (depth $dep) :";
	if( defined $v ){ $ret .= $self->{'pvs'}->($self) } else { $ret .= '<na>' }
	$ret .= "\n".$_->stringify() for @{$self->children()};
	return $ret;
}
# NEW: added traverse() (depth-first) and find_node_by_id()
# traverse all nodes of below the 'self' node (which can be the root node)
# param: sub to execute each time a node is visited with parameter the node
# if that sub returns 0 then the traverse is interrupted.
sub	traverse {
	my $self = $_[0];
	my $func = $_[1];
	$func->($self);
	for my $achild (@{ $self->children() }){
		# traverse() can be interrupted if func() returns 0
		return(0) unless $achild->traverse($func);
	}
	return 1;
}
# search all the nodes below 'self' (this can be the root node, i.e. the whole tree)
# for the node with specified id
# this is an example of using traverse()
sub	find_node_by_id {
	my $self = $_[0];
	my $id = $_[1];
	my $found;

	$self->traverse(sub {
		my $node = $_[0];
		# interrupt traverse() if node's id matches
		if( $id eq $node->id() ){ $found = $node; return 0 }
		return 1; # not found
	});
	return $found;
}
1;
} # end package Tree::Nary::Tiny

######
# Main
######

use strict;
use warnings;

# sub to be called on each node when we want to stringify it
# and knows how to handle the user-defined 'value' each node holds.
sub node_stringify {
	my $node = shift;
	return $node->value()->{'name'}
	." id=".$node->value()->{'id'}
	." parent=".(defined($node->parent()) ? $node->parent()->id() : "<noparent>")
}

# create the tree
my $T = Tree::Nary::Tiny->new(
	undef, # no parent
	0, # id
	{name=>"i am the tree holding your categories",id=>0}, # data
	\&node_stringify # sub to print each node
);

my ($cat0, $cat1, $cat2, $node0, $node1, $node2);
for my $i (1..2){
	$cat0 = "$i";
	# add this set of nodes to the root node of the tree, they are super-categories
	# @audioboxer 'Food', 'Drink', etc.
	$node0 = Tree::Nary::Tiny->new($T, $cat0, {name=>"my id is $cat0 - at level 0", id => $cat0}, \&node_stringify) or die "node0:";
	for my $j (1..2){
		$cat1 = "$i.$j";
		# 2nd level nodes, @audioboxer 'Vegetables', 'Fizzy' etc.
		$node1 = Tree::Nary::Tiny->new($node0, $cat1, {name=>"my id is $cat1 - at level 1", id => $cat1}, \&node_stringify) or die "node1";
		for my $k (1..2){
			$cat2 = "$i.$j.$k";
			# 3rd level nodes, @audioboxer 'Carrot', 'Sodaxyz'
			$node2 = Tree::Nary::Tiny->new($node1, $cat2, {name=>"my id is $cat2 - at level 2", id => $cat2}, \&node_stringify) or die "node2:";
		}
	}
}

# print the tree and love recursion
print $T->stringify()."\n";

print qq{\n\nThe """last""" category is....\n};

# find all the "last" categories, which are the leaf nodes,
# childless nodes.
my $leafs = $T->leaf_nodes();
print $_->stringify()."\n" for @$leafs;

# NEW:
# insert a new node under existing node (find by id)
my $newid = '2.1.20';
print "Inserting a new node with id $newid, under '2.1'...\n";
my $nodefound = $T->find_node_by_id('2.1');
$nodefound->add_child($newid, {name=>"new inserted node", id=>$newid});
print $T->stringify()."\n";