Tree::Nary - Perl implementation of N-ary search trees.

  use Tree::Nary;

  $node = new Tree::Nary;
  $another_node = new Tree::Nary;

  $inserted_node = $node->insert($parent, $position, $node);
  $inserted_node = $node->insert_before($parent, $sibling, $node);
  $inserted_node = $node->append($parent, $node);
  $inserted_node = $node->prepend($parent, $node);
  $inserted_node = $node->insert_data($parent, $position, $data);
  $inserted_node = $node->insert_data_before($parent, $sibling, $data);
  $inserted_node = $node->append_data($parent, $data);
  $inserted_node = $node->prepend_data($parent, $data);

  $node->reverse_children($node);

  $node->traverse($node, $order, $flags, $maxdepth, $funcref, $argref);

  $node->children_foreach($node, $flags, $funcref, $argref);

  $root_node = $obj->get_root($node);

  $found_node = $node->find($node, $order, $flags, $data);
  $found_child_node = $node->find_child($node, $flags, $data);

  $index = $node->child_index($node, $data);
  $position = $node->child_position($node, $child);

  $first_child_node = $node->first_child($node);
  $last_child_node = $node->last_child($node);

  $nth_child_node = $node->nth_child($node, $index);

  $first_sibling = $node->first_sibling($node);
  $next_sibling = $node->next_sibling($node);
  $prev_sibling = $node->prev_sibling($node);
  $last_sibling = $node->last_sibling($node);

  $bool = $node->is_leaf($node);
  $bool = $node->is_root($node);

  $cnt = $node->depth($node);

  $cnt = $node->n_nodes($node);
  $cnt = $node->n_children($node);

  $bool = $node->is_ancestor($node);

  $cnt = $obj->max_height($node);

  $node->tsort($node);

  $normalized_node = $node->normalize($node);

  $bool = $node->is_identical($node, $another_node);
  $bool = $node->has_same_struct($node, $another_node);

  $node->unlink($node);

#####################################################################################
# $Id: Nary.pm,v 1.3 2004/01/05 10:32:00 soriano Exp $
#####################################################################################
#
# Tree::Nary
#
# Author: Frederic Soriano <frederic.soriano@alcatel.fr>
# RCS Revision: $Revision: 1.3 $
# Date: $Date: 2004/01/05 10:32:00 $
#
#####################################################################################
#
# This package is free software and is provided "as is" without express or
# implied warranty.  It may be used, redistributed and/or modified under the
# same terms as Perl itself.
#
#####################################################################################

package Tree::Nary;

require 5.003;
require Exporter;

@ISA = qw(Exporter);

$VERSION = '1.3';

use strict;
use vars qw($TRUE $FALSE);
use vars qw($TRAVERSE_LEAFS $TRAVERSE_NON_LEAFS $TRAVERSE_ALL $TRAVERSE_MASK);
use vars qw($IN_ORDER $PRE_ORDER $POST_ORDER $LEVEL_ORDER);

#
# Constants
#

# Booleans
*TRUE  = \1;
*FALSE = \0;

# Tree traverse flags
*TRAVERSE_LEAFS		= \(1 << 0);					# Only leaf nodes should be visited.
*TRAVERSE_NON_LEAFS	= \(1 << 1);					# Only non-leaf nodes should be visited.
*TRAVERSE_ALL		= \($TRAVERSE_LEAFS | $TRAVERSE_NON_LEAFS);	# All nodes should be visited.
*TRAVERSE_MASK		= \0x03;

# Tree traverse orders
*IN_ORDER		= \1;
*PRE_ORDER		= \2;
*POST_ORDER		= \3;
*LEVEL_ORDER		= \4;

#
# Public methods
#

# Constructors, destructors

# Creates a new Tree::Nary node object, containing the given data, if any.
# Used to create the first node in a tree.
sub new() {

	my ($that, $newdata) = (shift, shift);
	my $class = ref($that) || $that;
	my $self = {
		data		=> undef,
		next		=> undef,
		prev		=> undef,
		parent		=> undef,
		children	=> undef,
	};

	if(defined($newdata)) {
		$self->{data} = $newdata;
	}

	# Transform $self into an object of class $class
	bless $self, $class;

	return($self);
}

# Frees allocated memory by removing circular references.
sub _free() {

	my ($self, $node) = (shift, shift);
	my $parent = $self->new();

	$parent = $node;

	while($TRUE) {
		if(defined($parent->{children})) {
			$self->_free($parent->{children});
		}
		if(defined($parent->{next})) {
			$parent = $parent->{next};
		} else {
			last;
		}
	}

	return;
}

# Removes the node and its children from the tree.
sub DESTROY() {

	my ($self, $root) = (shift, shift);

	if(!defined($root)) {
		return;
	}
	if(!$self->is_root($root)) {
		$self->unlink($root);
	}

	$self->_free($root);

	return;
}

# Unlinks a node from a tree, resulting in two separate trees.
sub unlink() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return;
	}

	if(defined($node->{prev})) {
		$node->{prev}->{next} = $node->{next};
	} elsif(defined($node->{parent})) {
		$node->{parent}->{children} = $node->{next};
	}

	$node->{parent} = undef;

	if(defined($node->{next})) {
		$node->{next}->{prev} = $node->{prev};
		$node->{next} = undef;
	}

	$node->{prev} = undef;

	return;
}

#
# Miscellaneous info methods
#

# Returns TRUE if the given node is a root node.
sub is_root() {

	my ($self, $node) = (shift, shift);

	return(!defined($node->{parent}) && !defined($node->{prev}) && !defined($node->{next}));
}

# Returns TRUE if the given node is a leaf node.
sub is_leaf() {

	my ($self, $node) = (shift, shift);

	return(!defined($node->{children}));
}

# Returns TRUE if $node is an ancestor of $descendant.
# This is true if node is the parent of descendant, or if node is the grandparent of descendant, etc.
sub is_ancestor() {

	my ($self, $node, $descendant) = (shift, shift, shift);

	if(!defined($node)) {
		return($FALSE);
	}
	if(!defined($descendant)) {
		return($FALSE);
	}

	while(defined($descendant)) {
		if(defined($descendant->{parent}) && ($descendant->{parent} == $node)) {
			return($TRUE);
		}

		$descendant = $descendant->{parent};
	}

	return($FALSE);
}

# Gets the root of a tree.
sub get_root() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	while(defined($node->{parent})) {
		$node = $node->{parent};
	}

	return($node);
}

# Gets the depth of a node.
sub depth() {

	my ($self, $node) = (shift, shift);
	my $depth = 0;

	while(defined($node)) {
		$depth++;
		$node = $node->{parent};
	}

	return($depth);
}

# Reverses the order of the children of a node.
sub reverse_children() {

	my ($self, $node) = (shift, shift);
	my $child = $self->new();
	my $last = $self->new();

	if(!defined($node)) {
		return;
	}

	$child = $node->{children};

	while(defined($child)) {
		$last = $child;
		$child = $last->{next};
		$last->{next} = $last->{prev};
		$last->{prev} = $child;
	}

	$node->{children} = $last;

	return;
}

# Gets the maximum height of all branches beneath a node.
# This is the maximum distance from the node to all leaf nodes.
sub max_height() {

	my ($self, $root) = (shift, shift);
	my $child = $self->new();
	my $max_height = 0;

	# <Deep recursion on subroutine "Tree::Nary::max_height">
	#   can be safely ignored.
	local $^W = 0;

	if(!defined($root)) {
		return(0);
	}

	$child = $root->{children};

	while(defined($child)) {

		my $tmp_height = $self->max_height($child);

		if($tmp_height > $max_height) {
			$max_height = $tmp_height;
		}

		$child = $child->{next};
	}

	return($max_height + 1);
}

# Gets the number of children of a node.
sub n_children() {

	my ($self, $node) = (shift, shift);
	my $n = 0;

	if(!defined($node)) {
		return(0);
	}

	$node = $node->{children};

	while(defined($node)) {
		$n++;
		$node = $node->{next};
	}

	return($n);
}

# Gets the position of a node with respect to its siblings.
# $child must be a child of $node.
# The first child is numbered 0, the second 1, and so on.
sub child_position() {

	my ($self, $node, $child) = (shift, shift, shift);
	my $n = 0;

	if(!defined($node)) {
		return(-1);
	}
	if(!defined($child)) {
		return(-1);
	}
	if(defined($child->{parent}) && !($child->{parent} == $node)) {
		return(-1);
	}

	$node = $node->{children};

	while(defined($node)) {
		if($node == $child) {
			return($n);
		}
		$n++;
		$node = $node->{next};
	}

	return(-1);
}

# Gets the position of the first child of a node which contains the given data.
sub child_index() {

	my ($self, $node, $data) = (shift, shift, shift);
	my $n = 0;

	if(!defined($node)) {
		return(-1);
	}

	$node = $node->{children};

	while(defined($node)) {
		if($node->{data} eq $data) {
			return($n);
		}
		$n++;
		$node = $node->{next};
	}

	return(-1);
}

# Gets the first sibling of a node. This could possibly be the node itself.
sub first_sibling() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	while(defined($node->{prev})) {
		$node = $node->{prev};
	}

	return($node);
}

# Gets the next sibling of a node.
sub next_sibling() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	return($node->{next});
}

# Gets the previous sibling of a node.
sub prev_sibling() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	return($node->{prev});
}

# Gets the last sibling of a node. This could possibly be the node itself.
sub last_sibling() {

	my ($self, $node) = (shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	while(defined($node->{next})) {
		$node = $node->{next};
	}

	return($node);
}

sub _count_func() {

	my ($self, $node, $flags, $nref) = (shift, shift, shift, shift);

	# <Deep recursion on subroutine "Tree::Nary::_count_func"> warnings
	#   can be safely ignored.
	local $^W = 0;

	if(defined($node->{children})) {

		my $child = $self->new();

		if($flags & $TRAVERSE_NON_LEAFS) {
			$$nref++;
		}

		$child = $node->{children};

		while(defined($child)) {
			$self->_count_func($child, $flags, $nref);
			$child = $child->{next};
		}

	} elsif($flags & $TRAVERSE_LEAFS) {
		$$nref++;
	}

	return;
}

# Gets the number of nodes in a tree.
sub n_nodes() {

	my ($self, $root, $flags) = (shift, shift, shift);
	my $n = 0;

	if(!(defined($root))) {
		return(0);
	}
	if(!($flags <= $TRAVERSE_MASK)) {
		return(0);
	}

	$self->_count_func($root, $flags, \$n);

	return($n);
}

# Gets the first child of a node.
sub first_child() {

	my ($self, $node) = (shift, shift);

	if(!(defined($node))) {
		return(undef);
	}

	return($node->{children});
}

# Gets the last child of a node.
sub last_child() {

	my ($self, $node) = (shift, shift);

	if(!(defined($node))) {
		return(undef);
	}

	$node = $node->{children};

	if(defined($node)) {
		while(defined($node->{next})) {
			$node = $node->{next};
		}
	}

	return($node);
}

# Gets a child of a node, using the given index.
# the first child is at index 0.
# If the index is too big, 'undef' is returned.
sub nth_child() {

	my ($self, $node, $n) = (shift, shift, shift);

	if(!defined($node)) {
		return(undef);
	}

	$node = $node->{children};

	if(defined($node)) {
		while(($n-- > 0) && defined($node)) {
			$node = $node->{next};
		}
	}

	return($node);
}

#
# Insert methods
#

# Inserts a node beneath the parent at the given position.
sub insert() {

	my ($self, $parent, $position, $node) = (shift, shift, shift, shift);

	if(!defined($parent)) {
		return($node);
	}
	if(!defined($node)) {
		return($node);
	}
	if(!$self->is_root($node)) {
		return($node);
	}

	if($position > 0) {
		return($self->insert_before($parent, $self->nth_child($parent, $position), $node));
	} elsif($position == 0) {
		return($self->prepend($parent, $node));
	} else {
		return($self->append($parent, $node));
	}
}

# Inserts a node beneath the parent before the given sibling.
sub insert_before() {

	my ($self, $parent, $sibling, $node) = (shift, shift, shift, shift);

	if(!defined($parent)) {
		return($node);
	}
	if(!defined($node)) {
		return($node);
	}
	if(!$self->is_root($node)) {
		return($node);
	}

	if(defined($sibling)) {
		if($sibling->{parent} != $parent) {
			return($node);
		}
	}

	$node->{parent} = $parent;

	if(defined($sibling)) {
		if(defined($sibling->{prev})) {
			$node->{prev} = $sibling->{prev};
			$node->{prev}->{next} = $node;
			$node->{next} = $sibling;
			$sibling->{prev} = $node;
		} else {
			$node->{parent}->{children} = $node;
			$node->{next} = $sibling;
			$sibling->{prev} = $node;
		}
	} else {
		if(defined($parent->{children})) {
			$sibling = $parent->{children};

			while(defined($sibling->{next})) {
				$sibling = $sibling->{next};
			}

			$node->{prev} = $sibling;
			$sibling->{next} = $node;
		} else {
			$node->{parent}->{children} = $node;
		}
	}

	return($node);
}

# Inserts a new node at the given position.
sub insert_data() {

	my ($self, $parent, $position, $data) = (shift, shift, shift, shift);

	return($self->insert($parent, $position, $self->new($data)));
}

# Inserts a new node before the given sibling.
sub insert_data_before() {

	my ($self, $parent, $sibling, $data) = (shift, shift, shift, shift);

	return($self->insert_before($parent, $sibling, $self->new($data)));
}

# Inserts a node as the last child of the given parent.
sub append() {

	my ($self, $parent, $node) = (shift, shift, shift);

	return($self->insert_before($parent, undef, $node));
}

# Inserts a new node as the first child of the given parent.
sub append_data() {

	my ($self, $parent, $data) = (shift, shift, shift);

	return($self->insert_before($parent, undef, $self->new($data)));
}

# Inserts a node as the first child of the given parent.
sub prepend() {

	my ($self, $parent, $node) = (shift, shift, shift);

	if(!defined($parent)) {
		return($node);
	}

	return($self->insert_before($parent, $parent->{children}, $node));
}

# Inserts a new node as the first child of the given parent.
sub prepend_data() {

	my ($self, $parent, $data) = (shift, shift, shift);

	return($self->prepend($parent, $self->new($data)));
}

#
# Search methods
#

sub _traverse_pre_order() {

	my ($self, $node, $flags, $funcref, $argref) = (shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		my $child = $self->new();

		if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

		$child = $node->{children};

		while(defined($child)) {

			my $current = $self->new();

			$current = $child;
			$child = $current->{next};
			if($self->_traverse_pre_order($current, $flags, $funcref, $argref)) {
				return($TRUE);
			}
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _depth_traverse_pre_order() {

	my ($self, $node, $flags, $depth, $funcref, $argref) = (shift, shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		my $child = $self->new();

		if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

		$depth--;
		if(!$depth) {
			return($FALSE);
		}

		$child = $node->{children};

		while(defined($child)) {

			my $current = $self->new();

			$current = $child;
			$child = $current->{next};

			if($self->_traverse_pre_order($current, $flags, $depth, $funcref, $argref)) {
				return($TRUE);
			}
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _traverse_post_order() {

	my ($self, $node, $flags, $funcref, $argref) = (shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		my $child = $self->new();

		$child = $node->{children};

		while(defined($child)) {

			my $current = $self->new();

			$current = $child;
			$child = $current->{next};

			if($self->_traverse_post_order($current, $flags, $funcref, $argref)) {
				return($TRUE);
			}
		}

		if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _depth_traverse_post_order() {

	my ($self, $node, $flags, $depth, $funcref, $argref) = (shift, shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		$depth--;
		if($depth) {

			my $child = $self->new();

			$child = $node->{children};

			while(defined($child)) {

				my $current = $self->new();

				$current = $child;
				$child = $current->{next};

				if($self->_depth_traverse_post_order($current, $flags, $depth, $funcref, $argref)) {
					return($TRUE);
				}
			}
		}
		if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _traverse_in_order() {

	my ($self, $node, $flags, $funcref, $argref) = (shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		my $child = $self->new();
		my $current = $self->new();

		$child = $node->{children};
		$current = $child;
		$child = $current->{next};

		if($self->_traverse_in_order($current, $flags, $funcref, $argref)) {
			return($TRUE);
		}
		if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

		while(defined($child)) {
			$current = $child;
			$child = $current->{next};
			if($self->_traverse_in_order($current, $flags, $funcref, $argref)) {
				return($TRUE);
			}
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _depth_traverse_in_order() {

	my ($self, $node, $flags, $depth, $funcref, $argref) = (shift, shift, shift, shift, shift, shift);

	if(defined($node->{children})) {

		$depth--;
		if($depth) {

			my $child = $self->new();
			my $current = $self->new();

			$child = $node->{children};
			$current = $child;
			$child = $current->{next};

			if($self->_depth_traverse_in_order($current, $flags, $depth, $funcref, $argref)) {
				return($TRUE);
			}
			if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
				return($TRUE);
			}

			while(defined($child)) {
				$current = $child;
				$child = $current->{next};
				if($self->_depth_traverse_in_order($current, $flags, $depth, $funcref, $argref)) {
					return($TRUE);
				}
			}

		} elsif(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($node, $argref)) {
			return($TRUE);
		}

	} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($node, $argref)) {
		return($TRUE);
	}

	return($FALSE);
}

sub _traverse_children() {

	my ($self, $node, $flags, $funcref, $argref) = (shift, shift, shift, shift, shift);
	my $child = $self->new();

	$child = $node->{children};

	while(defined($child)) {

		my $current = $self->new();

		$current = $child;
		$child = $current->{next};

		if(defined($current->{children})) {
			if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($current, $argref)) {
				return($TRUE);
			}
		} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($current, $argref)) {
			return($TRUE);
		}
	}

	$child = $node->{children};

	while(defined($child)) {

		my $current = $self->new();

		$current = $child;
		$child = $current->{next};

		if(defined($current->{children}) && $self->_traverse_children($current, $flags, $funcref, $argref)) {
			return($TRUE);
		}
	}

	return($FALSE);
}

sub _depth_traverse_children() {

	my ($self, $node, $flags, $depth, $funcref, $argref) = (shift, shift, shift, shift, shift, shift);
	my $child = $self->new();

	$child = $node->{children};

	while(defined($child)) {

		my $current = $self->new();

		$current = $child;
		$child = $current->{next};

		if(defined($current->{children})) {

			if(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($current, $argref)) {
				return($TRUE);
			}

		} elsif(($flags & $TRAVERSE_LEAFS) && &$funcref($current, $argref)) {
			return($TRUE);
		}
	}

	$depth--;
	if(!$depth) {
		return($FALSE);
	}

	$child = $node->{children};

	while(defined($child)) {

		my $current = $self->new();

		$current = $child;
		$child = $current->{next};

		if(defined($current->{children}) && $self->_depth_traverse_children($current, $flags, $depth, $funcref, $argref)) {
			return($TRUE);
		}
	}

	return($FALSE);
}

# Traverses a tree starting at the given root node. It calls the given function for each node visited.
# The traversal can be halted at any point by returning TRUE from given function.
sub traverse() {

	my ($self, $root, $order, $flags, $depth, $funcref, $argref) = (shift, shift, shift, shift, shift, shift, shift);

	if(!defined($root)) {
		return;
	}
	if(!defined($funcref)) {
		return;
	}
	if(!($order <= $LEVEL_ORDER)) {
		return;
	}
	if(!($flags <= $TRAVERSE_MASK)) {
		return;
	}
	if(!($depth == -1 || $depth > 0)) {
		return;
	}

	SWITCH:	{

		$order == $PRE_ORDER && do {

			if($depth < 0) {
				$self->_traverse_pre_order($root, $flags, $funcref, $argref);
			} else {
				$self->_depth_traverse_pre_order($root, $flags, $depth, $funcref, $argref);
			}
			last SWITCH;
		};
		$order == $POST_ORDER && do {

			if($depth < 0) {
				$self->_traverse_post_order($root, $flags, $funcref, $argref);
			} else {
				$self->_depth_traverse_post_order($root, $flags, $depth, $funcref, $argref);
			}
			last SWITCH;
		};
		$order == $IN_ORDER && do {

			if($depth < 0) {
				$self->_traverse_in_order($root, $flags, $funcref, $argref);
			} else {
				$self->_depth_traverse_in_order($root, $flags, $depth, $funcref, $argref);
			}
			last SWITCH;
		};
		$order == $LEVEL_ORDER && do {

			if(defined($root->{children})) {
				if(!(($flags & $TRAVERSE_NON_LEAFS) && &$funcref($root, $argref))) {
					if($depth < 0) {
						$self->_traverse_children($root, $flags, $funcref, $argref);
					} else {
						$depth--;
						if($depth) {
							$self->_depth_traverse_children($root, $flags, $depth, $funcref, $argref);
						}
					}
				}
			} elsif($flags & $TRAVERSE_LEAFS) {
				&$funcref($root, $argref);
			}
			last SWITCH;
		};
	} # End SWITCH
}

# Finds a node in a tree.
sub find() {

	my ($self, $root, $order, $flags, $data) = (shift, shift, shift, shift, shift);
	my @d;

	if(!defined($root)) {
		return(undef);
	}
	if(!($order <= $LEVEL_ORDER)) {
		return(undef);
	}
	if(!($flags <= $TRAVERSE_MASK)) {
		return(undef);
	}

	$d[0] = $data;
	$d[1] = undef;

	$self->traverse(
		$root, 
		$order, 
		$flags, 
		-1, 
		sub { 
			my ($node, $ref_of_array) = (shift, shift);

			if($$ref_of_array[0] ne $node->{data}) {
				return($FALSE);
			}

			$$ref_of_array[1] = $node;

			return($TRUE);
		}, 
		\@d
	);

	return($d[1]);
}

# Finds the first child of a node with the given data.
sub find_child() {

	my ($self, $node, $flags, $data) = (shift, shift, shift, shift);

	if(!defined($node)) {
		return(undef);
	}
	if(!($flags <= $TRAVERSE_MASK)) {
		return(undef);
	}

	$node = $node->{children};

	while(defined($node)) {

		if($node->{data} eq $data) {
			if($self->is_leaf($node)) {
				if($flags & $TRAVERSE_LEAFS) {
					return($node);
				}
			} else {
				if($flags & $TRAVERSE_NON_LEAFS) {
					return($node);
				}
			}
		}

		$node = $node->{next};
	}

	return(undef);
}

# Calls a function for each of the children of a node.
# Note that it doesn't descend beneath the child nodes.
sub children_foreach() {

	my ($self, $node, $flags, $funcref, $argref) = (shift, shift, shift, shift, shift);

	if(!defined($node)) {
		return;
	}
	if(!($flags <= $TRAVERSE_MASK)) {
		return;
	}
	if(!defined($funcref)) {
		return;
	}

	$node = $node->{children};

	while(defined($node)) {

		my $current = $self->new();

		$current = $node;
		$node = $current->{next};

		if($self->is_leaf($current)) {
			if($flags & $TRAVERSE_LEAFS) {
				&$funcref($current, $argref);
			}
		} else {
			if($flags & $TRAVERSE_NON_LEAFS) {
				&$funcref($current, $argref);
			}
		}
	}

	return;
}

#
# Sort methods
#

#_pchild_ref is just gathering references
sub _pchild_ref() {

	my ($node, $aref) = (shift, shift);

	push @$aref, $node;
}

# Sort a tree
sub tsort() {

	my ($self, $node) = (shift, shift);
	my @back;

	return if($self->is_leaf($node));

	# gather all the children references and sort them
	# according to the data field backwards (Z Y X W ...)
	$self->children_foreach($node, $Tree::Nary::TRAVERSE_ALL, \&_pchild_ref, \@back);
	@back = sort { $b->{data} cmp $a->{data} } @back;

	for (@back) {                # for every reference found (in backward order)
		$self->unlink($_);         # detach it from parent
		$self->prepend($node, $_); # prepend it 0> first child
		$self->tsort($_);          # call tsort recursively for its children
	}
}

#
# Comparison methods
#

# Generate a normalized tree
sub normalize() {

	my ($self, $node)   = (shift, shift);

	# Initialize result for a leaf
	my $result = '*';

	if(!$self->is_leaf($node)) {

		my @childs;
		my @chldMaps;

		$self->children_foreach($node, $Tree::Nary::TRAVERSE_ALL, \&_pchild_ref, \@childs);

		for(@childs) {
			push @chldMaps, $self->normalize($_);
		}

		$result = '('.join('', sort @chldMaps).')';
	}

	return($result);
}

# Compares two trees and returns TRUE if they are identical
# in their structures and their contents
sub is_identical() {

	my ($self, $t1, $t2) = (shift, shift, shift);
	my $i;
	my @t1childs;
	my @t2childs;

	# Exit if one of them is leaf and the other isn't
	return($FALSE) if(($self->is_leaf($t1) && !$self->is_leaf($t2)) or
		(!$self->is_leaf($t1) && $self->is_leaf($t2)));

	# Exit if they have different amount of children
	return($FALSE) if($self->n_children($t1) != $self->n_children($t2));

	# => HERE BOTH ARE LEAFS OR PARENTS WITH SAME AMOUNT OF CHILDREN

	return($FALSE) if($t1->{data} ne $t2->{data});     # exit if different content
	return($TRUE)  if($self->is_leaf($t1));              # if T1 is leaf, both are: hey, identical!!

	# => HERE BOTH ARE PARENTS WITH SAME AMOUNT OF CHILDREN

	# get the children references for $t1 and $t2
	$self->children_foreach($t1, $Tree::Nary::TRAVERSE_ALL, \&_pchild_ref, \@t1childs);
	$self->children_foreach($t2, $Tree::Nary::TRAVERSE_ALL,\&_pchild_ref, \@t2childs);

	for $i (0 .. scalar(@t1childs)-1) {      # iterate all children by index
		next if($self->is_identical($t1childs[$i], $t2childs[$i]) == $TRUE);
		return($FALSE);
	}

	return($TRUE);
}

# Compare the structure of two trees by comparing their canonical shapes
sub has_same_struct() {

	my ($self, $t1, $t2) = (shift, shift, shift);
	my $t1c = $self->normalize($t1);
	my $t2c = $self->normalize($t2);

	return($TRUE) if($t1c eq $t2c);      # if the two canons are identical, structure is same
	return($FALSE);                      # structure is different
}

1;

__END__