#
# Copyright (C) 1998,1999 Ken MacLeod
# Data::Grove::Parent is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: Parent.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $
#

###
### WARNING
###
###
### This code has a bug in it that renders it useless.  In the FETCH
### routines, the new object created should have a reference to the
### the tied object that has $self as the underlying value.  As of
### this version, I don't know of a way to get to the tied object.
###

# Search for places marked `VALIDATE' to see where validation hooks
# may be added in the future.

use strict;

#--------------------------------------------------------------------------
# Data::Grove::Parent
#--------------------------------------------------------------------------

package Data::Grove::Parent;

use UNIVERSAL;
use Carp;

use vars qw{ $VERSION };

# will be substituted by make-rel script
$VERSION = "0.08";

sub new {
    my $type = shift;
    my $raw = shift;
    my $parent = shift;

    if (UNIVERSAL::isa($raw, 'Data::Grove::Parent')) {
        return $raw;
    }

    my @properties = ( Raw => $raw );

    if (defined $parent) {
        push @properties, Parent => $parent;
    }

    my $dummy = bless {}, ref($raw);
    tie %$dummy, $type, @properties;
    return $dummy;
}

sub TIEHASH  {
    my $type = shift;

    return bless { @_ }, $type;
}

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

    if (exists $self->{$key}) {
	$self->{$key} = $value;
    } else {
	# VALIDATE
	if (UNIVERSAL::isa($value, 'Data::Grove::Parent')) {
	    $value = $value->{Raw};
	} elsif (UNIVERSAL::isa($value, 'Data::Grove::ParentList')) {
	    $value = $value->[0];
	}
	$self->{Raw}{$key} = $value;
    }
}

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

    if (exists $self->{$key}) {
	return $self->{$key};
    } else {
	my $value = $self->{Raw}{$key};
	if (ref($value) eq 'ARRAY') {
	    $value = Data::Grove::ParentList->new($value, $self);
	}
	return $value;
    }
}

sub FIRSTKEY {
    my $self = shift;
    my $raw = $self->{Raw};