=head1 NAME

multi_tree.pm  -- a multi node tree object.  Most useful for 
modeling heirarchial data structures.

=head1 SYNOPSIS

  use multi_tree;
  my $tree   = new multi_tree;
  my $handle = new multi_tree::handle($tree);

  $handle->set_key("top");
  $handle->set_key("level");

  $handle->add_child("child","1");
  $handle->add_child("child","2");

  $handle->first();
  $handle->down();

  $handle->add_child("grandchild","1-1");
  $handle->up();

  $handle->last();
  $handle->down();

  $handle->add_child("grandchild","2-1");
  $handle->up();
  
  $handle->top();
  &dump_tree($handle);

  sub dump_tree
  {
    ++$depth;
    my $handle = shift;
    my $lead = ' ' x ($depth*2);
    my($key,$val);
  
    ($key,$val) = $handle->get_data();

    print $lead, "key:   $key\n";
    print $lead, "val:   $val\n";
    print $lead, "depth: $depth\n";
  
    my $i;
    for( $i = 0; $i < scalar($handle->children); ++$i ) {
      $handle->down($i);
        &dump_tree($handle);
      $handle->up();
    }
    --$depth;
  }

=head1 DESCRIPTION

multi_tree, multi_tree::node, and multi_tree::handle are objects modeled after
C++ classes that I had written to help me model heirarchical information as
datastructures (such as the relationships between tables in an RDBMS).  The
tree is basicly a list of lists type data structure, where each node has a 
key, a value, and a list of children.  All operations perserve the order of
the child nodes.

=head2 Creating a Tree

The syntax of creating a handle based on a tree lets you have multiple handles
into a single tree without having to copy the tree.  You have to use a handle
to do anything at all to the tree.

When you first construct a tree, it will have a single empty node.  When you
construct a handle into that tree, it will set the top node in the tree as 
it's current node.  

  my $tree   = new multi_tree;
  my $handle = new multi_tree::handle($tree);

=head2 Using a Handle to Manipulate the Tree

At this point, you can set the key/value in the top node, or start adding
child nodes.

  $handle->set_key("blah");
  $handle->set_value("foo");

  $handle->add_child("quz","baz");
  # or
  $handle->add_child();

multi_tree::handle::add_child can take 3 paramters -- a key, a value, and a 
position.  The key and value will set the key/value of the child on construction.
If pos is passed, the new child will be inserted into the list of children.

To move the handle so it points at a child (so you can start manipulating that
child), there are a series of methods to call:

  $handle->first();   # sets the current child to the first in the list
  $handle->next();    # sets the next, or first if there was no next
  $handle->prev();    # sets the previous, or last if there was no next
  $handle->last();    # sets to the last child
  $handle->down();    # positions the handle's current node to the current child

To move back up, you can call the method up:

  $handle->up();      # moves to this node's parent

up() will fail if the current node has no parent node.  Most of the member functions
return either undef to indicate failure, or some other value to indicate success.

=head2 $multi_tree::debug

If set to a true value, it enables debugging output in the code.  This will likely
be removed in future versions as the code becomes more stable.

=head1 SEE ALSO

Books on data structures!

=head1 AUTHORS

Kyle R. Burton mortis@voicenet.com

=head1 BUGS

- There is currently no way to remove a child node.

- Not all the methods are tested, this is the first 
release and only very minimal testing has been done.

- This documentation pretty much sucks.


=cut 


################################################################################
package multi_tree;
require 5.004;

$VERSION = "0.9.0";
@ISA     = ();

use Carp;

sub new
{
  my $self = {};
  bless $self, shift;
  $self->{'top'} = multi_tree::node->new();
  return $self;
}


################################################################################
package multi_tree::node;
use Carp;

sub new 
{
  my $self = {};
  bless $self, shift;

  my $node = shift;
  if( ref($node) eq "multi_tree::node" ) {
    # become a copy of that node...
    $self->{'parent'}   = $node->parent;
    $self->{'children'} = [$node->children];
    $self->{'key'}      = $node->key;
    $self->{'value'}    = $node->value;
  }
  else {
    my($key,$value);
    $key = $node;
    $value = shift;
    print "[new] key,val = $key,$value\n" if $multi_tree::debug;
    $self->{'children'} = [];
    $self->{'parent'}   = undef;
    $self->{'key'}      = $key || undef;
    $self->{'value'}    = $value || undef;
  }

  return $self;
}

sub key
{
  my $self = shift;
  my $key = shift;

  if($key) {
    print "[key] setting key: $key on $self\n" if $multi_tree::debug;
    $self->{'key'} = $key;
  }

  return $self->{'key'};
}

sub value
{
  my $self = shift;
  my $value = shift;

  if( defined $value ) {
    print "[value] setting value: $value on $self\n" if $multi_tree::debug;
    $self->{'value'} = $value;
  }

  return $self->{'value'};
}

sub clear_key
{
  my $self = shift;
  undef $self->{'key'};
}

sub clear_value
{
  my $self = shift;
  undef $self->{'value'};
}

sub children 
{
  my $self = shift;
  return $self->{'children'};
}

sub parent
{
  my $self = shift;
  return $self->{'parent'};
}

sub dump
{
  my $self = shift;

  print "[dump] key:       ", $self->{'key'}, "\n";
  print "[dump] val:       ", $self->{'value'}, "\n";
  print "[dump] parent:    ", $self->{'parent'}, "\n";
  print "[dump] children:  ", $self->{'children'}, "\n";
}

################################################################################
package multi_tree::handle;
use Carp;

sub new
{
  my $self = {};
  bless $self, shift;
  my $tree = shift;
  print "ref(tree) is: ", ref($tree), "\n" if $multi_tree::debug;
  unless( ref($tree) eq "multi_tree" ) {
    confess "Error, invalid multi_tree refrence:  $tree\n";
  }

  $self->{'tree'}       = $tree;
  $self->{'curr_pos'}   = undef;
  $self->{'curr_node'}  = $tree->{'top'};
  $self->{'curr_child'} = undef;
  return $self;
}

sub get_data
{
  my $self = shift;
  my $node = $self->{'curr_node'};

  return($node->key,$node->value);
}

sub get_key
{
  my $self = shift;
  my $node = $self->{'curr_node'};

  my $key = $node->key();

  print "[get_key] getting from $node : $key\n" if $multi_tree::debug;

  return $key;
}

sub set_key
{
  my $self = shift;
  my $key = shift;
  my $node = $self->{'curr_node'};

  print "[set_key] setting key \"$key\" on: $node\n" if $multi_tree::debug;

  return $node->key($key);
}

sub get_value
{
  my $self = shift;
  my $node = $self->{'curr_node'};

  my $value = $node->value();

  print "[get_value] getting from $node : $value\n" if $multi_tree::debug;

  return $value;
}

sub set_value
{
  my $self = shift;
  my $value = shift;
  my $node = $self->{'curr_node'};

  print "[set_value] setting value \"$value\" on: $node\n" if $multi_tree::debug;

  return $node->value($value);
}

sub get_child
{
  my $self = shift;
  my $children = $self->{'curr_node'}->children;
  print "[get_child] children: $children\n" if $multi_tree::debug;
  my $pos = shift || $self->{'curr_pos'};

  unless( $pos <= $#{$children} ) {
    my $num = $#{$children};
    confess "Error, $pos is an invalid position [$num] $children.\n";
  }

  print "[get_child] returning [$pos]: ", ${$children}[$pos],
        "\n" if $multi_tree::debug;
  return( ${$children}[$pos] );
}

sub add_child
{
  my $self = shift;
  my($key,$value,$pos) = @_;
  my $children = $self->{'curr_node'}->children;
  print "[add_child] children: $children\n" if $multi_tree::debug;
  my $curr_pos = $self->{'curr_pos'};
  my $curr_node = $self->{'curr_node'};

  print "[add_child] adding child $child ($key,$value) to: $children\n" 
    if $multi_tree::debug;
  my $child = multi_tree::node->new($key,$value);
  $child->{'parent'} = $curr_node;

  if(defined $pos) {
    print "[add_child] adding at $pos $child\n" if $multi_tree::debug;
    unless($pos <= $#{$children}) {
      my $num =  $#{$children};
      confess "Position $pos is invalid for child position [$num] $children.\n";
    }
    splice( @{$children}, $pos, 1, $child, ${$children}[$pos] );
  }
  else {
    print "[add_child] adding at end $child\n" if $multi_tree::debug;
    push @{$children}, $child;
  }

  print "[add_child] children:", join(',',@{$self->{'curr_node'}->children}),
        "\n" if $multi_tree::debug;
}

sub position
{
  my $self = shift;
  my $pos = shift;

  unless( defined $pos ) {
    return $self->{'curr_pos'};
  }

  my $children = $self->{'curr_node'}->children;
  print "[position] children: $children\n" if $multi_tree::debug;
  unless( $pos <= $#{$children} ) {
    my $num = $#{$children};
    confess "Error, $pos is invalid [$num] $children.\n";
  }
  $self->{'pos'} = $pos;
  $self->{'curr_child'} = $self->get_child($pos);
  return $self->{'pos'};
}

sub first
{
  my $self = shift;

  $self->{'curr_pos'}   = 0;
  $self->{'curr_child'} = $self->get_child(0);
  print "[first] set child[",$self->{'curr_pos'},"]: ",$self->{'curr_child'},
        "\n" if $multi_tree::debug;
  return $self->{'curr_pos'};
}

sub next
{
  my $self = shift;
  my $pos = $self->{'curr_pos'} + 1;
  my $children = $self->{'curr_node'}->children;
  print "[next] children: $children\n" if $multi_tree::debug;

  unless( $pos >= 0 && $pos <= $#{$children} ) {
    return undef;
  }

  $self->{'curr_pos'}   = $pos;
  $self->{'curr_child'} = $self->get_child($pos);
  return $self->{'curr_pos'};
}

sub prev
{
  my $self = shift;
  my $pos = $self->{'curr_pos'} - 1;
  my $children = $self->{'curr_node'}->children;
  print "[prev] children: $children\n" if $multi_tree::debug;

  unless( $pos >= 0 && $pos <= $#{$children} ) {
    return undef;
  }

  $self->{'curr_pos'}   = $pos;
  $self->{'curr_child'} = $self->get_child($pos);
  return $self->{'curr_pos'};
}

sub last
{
  my $self = shift;
  my $children = $self->{'curr_node'}->children;
  my $pos = $#{$children};
  print "[last] children [$pos]: $children\n" if $multi_tree::debug;

  $self->{'curr_pos'}   = $pos;
  $self->{'curr_child'} = $self->get_child($pos);
  return $self->{'curr_pos'};
}

sub down
{
  my $self = shift;
  my $pos = shift;
  my $children = $self->{'curr_node'}->children;
  print "[down] children: $children\n" if $multi_tree::debug;

  if( defined $pos ) {
    unless( $self->position($pos) ) {
      confess "Error, $pos was an invalid position.\n";
    }
  }

  $self->{'curr_pos'}   = undef;
  $self->{'curr_node'}  = $self->{'curr_child'};
  $self->{'curr_child'} = undef;
  print "[down] set to: ", $self->{'curr_node'}, "\n" if $multi_tree::debug;

  return 1;
}

sub up
{
  my $self = shift;
  my $node = $self->{'curr_node'};
  my $parent = $node->parent();

  unless( defined $parent ) {
    return undef;
  }
  
  $self->{'curr_pos'}   = undef;
  $self->{'curr_node'}  = $parent;
  $self->{'curr_child'} = undef;

  return 1;
}

sub top
{
  my $self = shift;
  my $tree = $self->{'tree'};

  $self->{'curr_pos'}   = undef;
  $self->{'curr_node'}  = $tree->{'top'};
  $self->{'curr_child'} = undef;

  return 1;
}

sub children
{
  my $self = shift;
  my $children = $self->{'curr_node'}->children;

  return @{$children};
}


1;