#
# $Id: Orchard.pm,v 1.3 2000/10/05 20:54:10 kmacleod Exp $
#

use strict;
use Class::Orchard::Node;

package XML::Orchard;
use vars qw{ $VERSION };

$VERSION = "0.00";

package XML::Orchard::Document;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Contents}) {
	$self->{Contents} = [];
    }

    return $self;
}

sub GET_NodeType {
    return 'document';
}

sub GET_Root {
    my $self = shift;

    my $content = $self->{"{}Contents"};
    foreach my $node (@$content) {
	return $node if $node->FETCH('NodeType') eq 'element';
    }
    return undef;
}

sub SET_Root {
    die "Root: readonly property";
}

package XML::Orchard::Element;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Contents}) {
	$self->{Contents} = [];
    }

    return $self;
}

sub GET_NodeType {
    return 'element';
}

sub GET_Name {
    my $self = shift;

    my $prefix = $self->FETCH('Prefix');
    if (defined $prefix) {
	return $prefix . ":" . $self->FETCH('LocalName');
    } else {
	return $self->FETCH('LocalName');
    }
}

sub SET_Name {
    my ($self, $name) = @_;

    my ($prefix, $localname) = split(':', $name, 2);
    if (!defined $localname) {
	$self->STORE('Prefix', undef);
	$self->STORE('LocalName', $prefix);
    } else {
	$self->STORE('Prefix', $prefix);
	$self->STORE('LocalName', $localname);
    }
}

sub SET_Attributes {
    my ($self, $attrs) = @_;

    if (ref($attrs) eq 'ARRAY') {
	my $new_attrs = XML::Orchard::_Attributes->new();
	foreach my $attr (@$attrs) {
	    $new_attrs->{[$attr->{NamespaceURI},
			  $attr->{LocalName}]} = $attr;
	}
	$self->{'{}Attributes'} = $new_attrs;
    } else {
	die "Attributes: can only assign ARRAYs\n";
    }
}

package XML::Orchard::_Attributes;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub FETCH {
    my ($underlying_data, $key) = @_;

    if (ref($key) or $key !~ /:/) {
	return $underlying_data->SUPER::FETCH($key);
    }

    # note: the return value is indeterminate if there is more than
    # one attribute with the same prefix and localname (but different
    # namespace, which is allowed)
    my ($prefix, $localname) = split(':', $key, 2);
    foreach my $attr (values %$underlying_data) {
	if (defined $attr->{Prefix}
	    and $attr->{Prefix} eq $prefix
	    and $attr->{LocalName} eq $localname) {
	    return $attr;
	}

    }

    return undef;
}

sub STORE {
    my ($underlying_data, $key, $value) = @_;

    if (ref($key) eq 'ARRAY') {
	my ($namespace, $localname) = @$key;
	$value->{NamespaceURI} = $namespace
	    if (defined $namespace and !defined $value->{NamespaceURI});
	$value->{LocalName} = $localname
	    if (!defined $value->{LocalName});
	$underlying_data->SUPER::STORE([$value->{NamespaceURI},
					$value->{LocalName}], $value);
	return;
    } elsif ($key !~ /:/) {
	$value->{LocalName} = $key
	    if (!defined $value->{LocalName});
	$underlying_data->SUPER::STORE([$value->{NamespaceURI},
					$value->{LocalName}], $value);
	return;
    }

    die "Attributes: can't store to qualified name\n";
}

package XML::Orchard::Attribute;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Value}) {
	$self->{Value} = "";
    }

    return $self;
}

sub GET_NodeType {
    return 'attribute';
}

sub GET_Name {
    my $self = shift;

    my $prefix = $self->FETCH('Prefix');
    if (defined $prefix) {
	return $prefix . ":" . $self->FETCH('LocalName');
    } else {
	return $self->FETCH('LocalName');
    }
}

sub SET_Name {
    my ($self, $name) = @_;

    my ($prefix, $localname) = split(':', $name, 2);
    if (!defined $localname) {
	$self->STORE('Prefix', undef);
	$self->STORE('LocalName', $prefix);
    } else {
	$self->STORE('Prefix', $prefix);
	$self->STORE('LocalName', $localname);
    }
}

package XML::Orchard::Characters;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Data}) {
	$self->{Data} = "";
    }

    return $self;
}

sub GET_NodeType {
    return 'characters';
}

package XML::Orchard::Comment;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Data}) {
	$self->{Data} = "";
    }

    return $self;
}

sub GET_NodeType {
    return 'comment';
}

package XML::Orchard::ProcessingInstruction;
use vars qw{ @ISA };
@ISA = qw{ Class::Orchard::Node };

sub new {
    my $type = shift;

    my $self = $type->SUPER::new(@_);

    if (!defined $self->{Data}) {
	$self->{Data} = "";
    }

    return $self;
}

sub GET_NodeType {
    return 'processing_instruction';
}

1;