#! /usr/local/bin/perl
###########################################################################
#
# VOTable::DOM.pm
#
# written by Raymond Plante for VO applications (based on BIMAarch::DOM.pm
# written for the NCSA BIMA Data Archive).  
#
# To install:
#  0.  Make sure your using Perl 5.
#  1.  Install XML::DOM perl module
#  2.  Place this file, "DOM.pm", in one of your Perl module directories 
#      under a subdirectory called "VOTable"
#       For example, if /usr/local/lib/perl5/site_perl/5.00556 holds 
#       locally installed modules, put save this file as
#       /usr/local/lib/perl5/site_perl/5.00556/VOTable/DOM.pm
#
###########################################################################

package VOTable::DOM;

use XML::DOM;
use XML::Writer;
use Carp;

require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw(formatRow);

#**
# format a table row as XML
##
sub formatRow {
    my $out = "<TR>";
    for $td (@_) {
        $out .= "<TD>$td</TD>";
    }
    $out .= "</TR>";
    return $out;
}

#**
# a VOTable DTD element.  This serves as a base class for specialized 
# VOTable elements.  
##
package VOTable::DOM::Element;
use UNIVERSAL qw(isa);

@ISA       = qw(XML::DOM::Element);

import Carp;

#**
# create a new generic VOTable element.  Objects of this type can be 
# constructed explicitly via this constructor; however, this constructor
# is typically called when constructing subclasses.
#
# @param elname     the element tag name 
# @optparam doc     the parent document.  If not provided, one is constructed.
# @optparam indent  the indentation amount (see setIndent()).
##
sub new {
    my $class = shift;
    my $elname = shift;
    my $doc = shift;
    my $indent = shift;
    $indent = 4 if ($indent eq '');

    $doc = new XML::DOM::Document if ($doc eq '');
    my $self = new XML::DOM::Element($doc, $elname);
    bless $self, $class;
    $self->setIndent($indent);
    $self->{ChildIndent} = 0;
    $self->{PrintState} = 0;

    return $self;
}

#**
# set the indentation for children of this element.  This amount is used 
# by the print method to provide an indented organization to the output.
#
# @param num        an integer number of spaces to indent
# @optparam parent  if given, add the parents indentation amount as well.
##
sub setIndent {
    my $self = shift;
    $self->{PrintIndent} = shift;
    $self->{PrintIndent} += $_[0]->{PrintIndent} if (@_ > 0);
}

#**
# increase the indentation for children of this element by a given amount.  
# This amount is used by the print method to provide an indented organization 
# to the output.
#
# @param num   an integer number of spaces to increase the indentation by
# @optparam parent  if given, add the parents indentation amount as well.
##
sub incrIndent {
    my $self = shift;
    $self->{PrintIndent} += shift;
    $self->{PrintIndent} += $_[0]->{PrintIndent} if (@_ > 0);
}

#**
# get the indentation for children of this element.  This amount is used by 
# the print method to provide an indented organization to the output.
##
sub getIndent { 
    my $self = shift;
    return $self->{PrintIndent};
}

$curindent = 0;

sub _printHead { 
    my($s, $FILE) = @_;
    my $name = $s->{TagName};
    $FILE->print ("<$name");

    for my $att (@{$s->{A}->getValues})
    {
        # skip un-specified (default) Attr nodes
        if ($att->isSpecified)
        {
            $FILE->print (" ");
            $att->print ($FILE);
        }
    }

    if (! $s->hasChildNodes() && $s->{StopPrint} == 0) {
        my $style = &$XML::DOM::TagStyle ($name, $s);
        if ($style == 0)
        {
            $FILE->print ("/>");
        }
        elsif ($style == 1)
        {
            $FILE->print ("></$name>");
        }
        else
        {
            $FILE->print (" />");
        }

        $s->{PrintState} = 3 if ($s->{PrintState} < 3);
    }
    else {
        $FILE->print(">");
        $s->{PrintState} = 1 if ($s->{PrintState} < 1);
    }
}

sub _printChildren {
    my($s,$FILE) = @_;
    my $indent = '';
    my $stop = 0;

    my @kids = @{$s->{C}};
    if (@kids == 1 && $kids[0]->getNodeType() == XML::DOM::TEXT_NODE) {
        $kids[0]->print($FILE) if (! $kids[0]->{PrintState});
        $kids[0]->{PrintState} = 3 if ($kids[0]->{PrintState} eq '');
        $s->{NoEndIndent} = 1;
    }
    elsif (@kids > 0) { 
        $doc->{ChildIndent} += $s->{PrintIndent};
        $indent = " " x $doc->{ChildIndent} if ($doc->{ChildIndent} > 0);
        for my $kid (@kids)
        {
            next if ($kid->{PrintState} eq "3");
            if ($kid->{PrintState} ne '' && $kid->{PrintState} < 1) {
                $FILE->print("\n");
                $FILE->print($indent);
            }
            $kid->print ($FILE);
            $kid->{PrintState} = 3 if ($kid->{PrintState} eq '');
            if ($kid->{PrintState} < 3) {
                $doc->{ChildIndent} -= $s->{PrintIndent};
                return;
            }
        }
        $FILE->print("\n");
        $doc->{ChildIndent} -= $s->{PrintIndent};
    }
    $s->{PrintState} = 2 if ($s->{PrintState} < 2 && @kids > 0);
}

sub _printTail {
    my($s,$FILE) = @_;
    my $name = $s->{TagName};
    my $indent = '';
    if (! $s->{NoEndIndent} && $doc->{ChildIndent} > 0) {
        $indent = " " x $doc->{ChildIndent};
        $FILE->print($indent);
        $s->{NoEndIndent} = 0;
    }
    $FILE->print("</$name>");
    $s->{PrintState} = 3 if ($s->{PrintState} < 3);
}    

#**
# print this element.  This overrides the print method inherited from 
# XML::DOM::Element.
#
# @param FILE   a handle object with a print method.
##
sub print
{
    my ($self, $FILE) = @_;    
    $doc->{ChildIndent} = 0 if ($doc->{ChildIndent} eq '');

    # don't do anything if this node has been marked as printed
    return if ($self->{PrintState} > 2 || $self->{StopPrint} > 2);

    $self->_printHead($FILE) if ($self->{PrintState} == 0);
    return if ($self->{StopPrint} > 1 || $self->{PrintState} == 3);
    $self->_printChildren($FILE) if ($self->{PrintState} == 1);
    return if (($self->hasChildNodes() && $self->{PrintState} < 2) || 
               $self->{StopPrint} > 0);
    $self->_printTail($FILE);

    return;
}

#**
# a VOTable document
##
package VOTable::DOM::Document;

@ISA = qw(XML::DOM::Document);

#**
# create a new VOTable document
# @param desc   description text
##
sub new {
    my $class = shift;
    my $desc = shift;

    my $doc = XML::DOM::Document->new();
    bless $doc, $class;
    $doc->{ChildIndent} = 0;

    # set the DOCTYPE
    my $child = $doc->createDocumentType("VOTABLE", 
                                         "http://us-vo.org/xml/VOTable.dtd");
    $doc->setDoctype($child);

    # set the root node
    my $root = new VOTable::DOM::VOTABLE($doc, $desc);
    $doc->appendChild($root);
    $doc->{VOT_root} = $root;

    return $doc;
}

#*
# create a VOTable element node.  This overrides the version from 
# XML::DOM::Element
##
sub createElement {
    return new VOTable::DOM::Element($_[1], $_[0]);
}

sub createTextElement {
    my($doc, $elnm, $elval) = @_;
    my($elnode) = $doc->createElement($elnm);
    if ($elval ne '') {
	my($elcdata) = $doc->createTextNode($elval);
	$elnode->appendChild($elcdata);
    }
    return $elnode;
}

#*
# set the description for this VOTable
# @param desc  the description text
##
sub setDescription {
    return $_[0]->{VOT_root}->setDescription($_[1]);
}

#*
# add a coordinate system definition below the root node
# @param id   the system id
# @param sys  the system type (one of the defined values)
# @param eq   the equinox as a decimal year
# @param ep   the epoch as a decimal year
##
sub addCooSysDef {
    my $self = shift;
    return $self->{VOT_root}->addCooSysDef(@_);
}

#*
# add a parameter
# @param id     the parameter id
# @param value  the parameter value
# @param desc   a text description of the parameter
##
sub addParam {
    my $self = shift;
    return $self->{VOT_root}->addParam(@_);
}

#**
# add a RESOURCE node to the root of this document
# @param id      the id for the resource (opt.)
# @param name    the name of the resource (opt.)
# @param asmeta  if true, set the "type" attribute to "meta"; otherwise,
#                   it will be set to "results".  If not specified, the 
#                   attribute will not be set. (opt.)
sub addResource {
    my $self = shift;
    return $self->{VOT_root}->addResource(@_);
}

sub print {
    my $s = shift;
    if ($s->{VOT_root}->{PrintState} == 0) {
        $s->{ChildIndent} = 0;
        $s->SUPER::print(@_);
    }
    else {
        $s->{VOT_root}->print(@_);
        $_[0]->print("\n");
    }
}

#**
# the VOTable root node
##
package VOTable::DOM::VOTABLE;

@ISA = qw(VOTable::DOM::Element);

#**
# create a new VOTable document
# @param desc   description text
##
sub new {
    my $class = shift;
    my $doc = shift;
    my $desc = shift;

    my $root = $doc->createElement("VOTABLE");
    bless $root, $class;

    $root->setAttribute("version", "v1.0");
    
    $root->setDescription($desc) if ($desc !~ /^\s*$/);
    return $root;
}

#*
# set the description for this VOTable
# @param desc  the description text
##
sub setDescription {
    my $self = shift;
    my $desc = shift;
    my $doc = $self->getOwnerDocument();
    my $descnode = $doc->createTextElement("DESCRIPTION", $desc);

    my $nlist = $self->getElementsByTagName("DESCRIPTION");
    if ($nlist->getLength() > 0) {
        $self->replaceChild($descnode, $nlist->item(0));
    } elsif ($self->hasChildNodes()) {
        $self->insertBefore($descnode, $self->getFirstChild());
    } else {
        $self->appendChild($descnode);
    }

    return $descnode;
}

#*
# add a DEFINITIONS node if it does not exist already and return it.
##
sub setDefinitions {
    my $self = shift;
    my $doc = $self->getOwnerDocument();

    my $nlist = $self->getElementsByTagName("DEFINITIONS");
    return $nlist->item(0) if ($nlist->getLength() > 0);

    my $defnode = $doc->createElement("DEFINITIONS");
    $nlist = $self->getElementsByTagName("DESCRIPTION");
    if ($nlist->getLength() > 0) {
        my $tmp = $nlist->item(($nlist->getLength())-1);
        if ($tmp->getNextSibling()) {
            $self->insertBefore($defnode, $tmp->getNextSibling());
        } else {
            $self->appendChild($defnode);
        }
    }
    elsif ($self->hasChildNodes()) {
        $self->insertBefore($defnode, $self->getFirstChild());
    } 
    else {
        $self->appendChild($defnode);
    }

    return $defnode;
}

#*
# add a coordinate system definition 
# @param id   the system id
# @param sys  the system type (one of the defined values)
# @param eq   the equinox as a decimal year
# @param ep   the epoch as a decimal year
##
sub addCooSysDef {
    my $self = shift;
    my ($id, $sys, $eq, $ep, $txt) = @_;
    my $doc = $self->getOwnerDocument();

    my $defs = $self->setDefinitions();
    my $def = $doc->createTextElement("COOSYS", $txt);
    $def->setAttribute("ID", $id) if ($id);
    $def->setAttribute("system", $sys) if ($sys);
    $def->setAttribute("equinox", $eq) if ($eq);
    $def->setAttribute("epoch", $ep) if ($ep);

    $defs->appendChild($def);
    return $def;
}

#*
# add a parameter
# @param id     the parameter id
# @param value  the parameter value
# @param desc   a text description of the parameter
##
sub addParam {
    my($self, $id, $value, $desc) = @_;
    my $doc = $self->getOwnerDocument();
    my $defs = $self->setDefinitions();
    my $node = VOTable::DOM::PARAM->new($doc, $id, $value, $desc);
    $defs->appendChild($node);
    return $node;
}

#**
# add a RESOURCE node.  
# @param id      the id for the resource (opt.)
# @param name    the name of the resource (opt.)
# @param asmeta  if true, set the "type" attribute to "meta"; otherwise,
#                   it will be set to "results".  If not specified, the 
#                   attribute will not be set. (opt.)
sub addResource {
    my($s, $name, $id, $asmeta) = @_;
    my $doc = $s->getOwnerDocument();
    my $node = VOTable::DOM::RESOURCE->new($doc, $id, $name, $asmeta);
    $s->appendChild($node);
    return $node;
}

#*
# a base class for PARAM and FIELD elements
##
package VOTable::DOM::PARAMFIELD;

@ISA = qw(VOTable::DOM::Element);

#*
# set the datatype of the Field
# @param type
##
sub setDatatype {
    $_[0]->setAttribute("datatype", $_[1]);
}

#*
# set the data width of the Field
# @param type
##
sub setWidth {
    $_[0]->setAttribute("width", $_[1]);
}

#*
# set the data precision of the Field
# @param type
##
sub setPrecision {
    $_[0]->setAttribute("precision", $_[1]);
}

#*
# set the data unit of the Field
# @param type
##
sub setUnit {
    $_[0]->setAttribute("unit", $_[1]);
}

#*
# set the data ucd of the Field
# @param type
##
sub setUCD {
    $_[0]->setAttribute("ucd", $_[1]);
}

#*
# set the data name of the Field
# @param type
##
sub setName {
    $_[0]->setAttribute("name", $_[1]);
}

#*
# set the data value of the Field
# @param type
##
sub setValue {
    $_[0]->setAttribute("value", $_[1]);
}

#*
# set the data array size of the Field
# @param type
##
sub setArraysize {
    $_[0]->setAttribute("arraysize", $_[1]);
}

#*
# add a description entry
# @param desc  the description
##
sub addDescription {
    my($self, $desc) = @_;
    my $doc = $self->getOwnerDocument();
    my $descnode = $doc->createTextElement("DESCRIPTION", $desc);
    $self->appendChild($descnode);
    return $descnode;
}

#*
# add a VALUES node
# @param id  the ID attribute to give it (opt.)
##
sub addValues {
    my($s,$id) = @_;
    my $doc = $s->getOwnerDocument();
    my $node = VOTable::DOM::VALUES->new($doc, $id);
    $node->appendChild($node);
    return $node;
}

#*
# the PARAM element
##
package VOTable::DOM::PARAM;

@ISA = qw(VOTable::DOM::PARAMFIELD);

#**
# create a new PARAM element
# @param id
# @param value
# @param desc   a text description of the parameter
##
sub new {
    my($class, $doc, $id, $value, $desc) = @_;

    my $node = $doc->createElement("PARAM");
    bless $node, $class;
    $node->setAttribute("ID", $id) if ($id ne '');
    $node->setAttribute("value", $value) if ($value ne '');

    $node->addDescription($desc) if ($desc ne '');
    return $node;
}

#*
# the VALUES element
##
package VOTable::DOM::VALUES;

@ISA = qw(VOTable::DOM::Element);

#**
# create a new VALUES element
# @param doc  the owning document
# @param id   the ID attribute to give it (optional)
##
sub new {
    my($class, $doc, $id) = @_;
    my $node = $doc->createElement("VALUES");
    $node->setAttribute("ID", $id) if ($id ne '');
    bless $node, $class;
}

#**
# add a minimum value
# @param value  the minimum value
# @param incl   the inclusive attribute (should be "yes" or "no"; optional)
# @param text   text to enclose
##
sub addMin {
    my($s, $value, $incl, $text) = @_;
    my $doc = $s->getOwnerDocument();
    my $node = $doc->createTextElement("MIN", $text);
    $node->setAttribute("value", $value) if ($value ne '');
    $node->setAttribute("inclusive", $incl) if ($incl ne '');
    $s->appendChild($node);
    return $node;
}

#**
# add a maximum value
# @param value  the maximum value
# @param incl   the inclusive attribute (should be "yes" or "no"; optional)
# @param text   text to enclose
##
sub addMax {
    my($s, $value, $incl, $text) = @_;
    my $doc = $s->getOwnerDocument();
    my $node = $doc->createTextElement("MAX", $text);
    $node->setAttribute("value", $value) if ($value ne '');
    $node->setAttribute("inclusive", $incl) if ($incl ne '');
    $s->appendChild($node);
    return $node;
}

#**
# add an OPTION
# @param name    the option name
# @param value   the option value
##
sub addOption {
    my($s, $value, $name);
    my $doc = $s->getOwnerDocument();
    my $node = $doc->createElement("OPTION");
    $node->setAttribute("name", $name) if ($name ne '');
    $node->setAttribute("value", $value);
    $s->appendChild($node);
    return $node;
}

#**
# the RESOURCE element
##
package VOTable::DOM::RESOURCE;


@ISA = qw(VOTable::DOM::Element);

#**
# create a new RESOURCE element
# @param id      the id for the resource (opt.)
# @param name    the name of the resource (opt.)
# @param asmeta  if true, set the "type" attribute to "meta"; otherwise,
#                   it will be set to "results".  If not specified, the 
#                   attribute will not be set. (opt.)
##
sub new {
    my($class,$doc,$id,$name,$asmeta) = @_;
    my $node = $doc->createElement("RESOURCE");
    $node->setAttribute("name", $name) if ($name ne '');
    $node->setAttribute("ID", $name) if ($id ne '');
    if ($asmeta ne '') {
	if ($asmeta) {
	    $node->setAttribute("type", "meta");
	} else {
	    $node->setAttribute("type", "results");
	}
    }
    bless $node, $class;
}

#*
# add a description entry
# @param desc  the description
##
sub addDescription {
    my($self, $desc) = @_;
    my $doc = $self->getOwnerDocument();
    my $descnode = $doc->createTextElement("DESCRIPTION", $desc);
    $self->appendChild($descnode);
    return $descnode;
}

#*
# add a Table to this Resource
# @param id     the table id  (opt.)
# @param name   the table name (opt.)
# @param desc   a description for the table (opt.)
# @param ref    the table reference (opt.)
##
sub addTable {
    my($s,$id,$name,$desc,$ref) = @_;
    my $doc = $s->getOwnerDocument();
    $table = VOTable::DOM::TABLE->new($doc,$id,$name,$desc,$ref);
    $s->appendChild($table);
    return $table;
}

#**
# the TABLE element
##
package VOTable::DOM::TABLE;


@ISA = qw(VOTable::DOM::Element);

#**
# create a new TABLE element
# @param id     the table id  (opt.)
# @param name   the table name (opt.)
# @param desc   a description for the table (opt.)
# @param ref    the table reference (opt.)
##
sub new {
    my($class,$doc,$id,$name,$desc,$ref) = @_;
    my $node = $doc->createElement("TABLE");
    $node->setAttribute("name", $name) if ($name ne '');
    $node->setAttribute("ID", $id) if ($id ne '');
    $node->setAttribute("ref", $ref) if ($ref ne '');
    bless $node, $class;
    $node->addDescription($desc) if ($desc ne '');
    return $node;
}

#*
# add a description entry
# @param desc  the description
##
sub addDescription {
    my($self, $desc) = @_;
    my $doc = $self->getOwnerDocument();
    my $descnode = $doc->createTextElement("DESCRIPTION", $desc);
    my $nodelist = $self->getElementsByTagName("DATA");
    if ($nodelist->getLength() > 0) {
	$self->insertBefore($descnode,$nodelist->item(0));
    } else {
	$self->appendChild($descnode);
    }
    return $descnode;
}

#*
# add a Field description to this table
# @param id        the field id
# @param datatype  the field data type  (opt.)
# @param ucd       the UCD identifier  (opt.)
# @param desc      a description (opt.)
##
sub addField {
    my $self = shift;
    my $doc = $self->getOwnerDocument();
    my $fld = VOTable::DOM::FIELD->new($doc, @_);
    my $nodelist = $self->getElementsByTagName("DATA");
    if ($nodelist->getLength() > 0) {
	$self->insertBefore($fld,$nodelist->item(0));
    } else {
	$self->appendChild($fld);
    }
    return $fld;
}

#**
# set the data container type
# @param type  either "table", "binary", or "fits"
##
sub setData {
    my($s,$type) = @_;
    my $doc = $s->getOwnerDocument();
    my @typenames = ("TABLEDATA", "BINARY", "FITS");
    if ($type =~ /^table/i) {
        $type = "TABLEDATA";
    } elsif ($type =~ /^fits$/i) {
        $type = "FITS";
    } else {
        $type = "BINARY";
    }

    my $data = '';
    if ($s->hasChildNodes()) {
        $data = $s->getElementsByTagName("DATA")->item(0);
    }
    if (! $data) {
        $data = $doc->createElement("DATA");
        $s->appendChild($data);
    }

    my $datatype = '';
    if ($data->hasChildNodes()) {
        $datatype = $data->firstChild();
        while ($datatype && $datatype->getNodeType() != XML::DOM::ELEMENT_NODE)
        {
            $datatype = $datatype->nextSibling();
        }
    }

    if (! $datatype || $datatype->getTagName() != $type) {
        my $tmp;
        if ($type eq "TABLEDATA") {
            $tmp = VOTable::DOM::TABLEDATA->new($doc);
        } else {
            $tmp = $doc->createElement($type);
        }

        if (! $datatype) {
            $data->appendChild($tmp);
        } else {
            $data->replaceChild($tmp, $datatype);
        }
        $datatype = $tmp;
    }

    return $datatype;
}

#**
# the FIELD element
##
package VOTable::DOM::FIELD;


@ISA = qw(VOTable::DOM::PARAMFIELD);

#**
# create a new FIELD element
# @param id        the field id
# @param datatype  the field data type  (opt.)
# @param ucd       the UCD identifier  (opt.)
# @param ref       the field reference (opt.)
##
sub new {
    my($class,$doc,$id,$datatype,$ucd,$desc) = @_;
    my $node = $doc->createElement("FIELD");
    $node->setAttribute("ID", $name) if ($id ne '');
    $node->setAttribute("ucd", $ucd) if ($ucd ne '');
    $node->setAttribute("datatype", $datatype) if ($datatype ne '');
    bless $node, $class;
    $node->addDescription($desc) if ($desc ne '');
    return $node;
}

#**
# a TABLEDATA node
##
package VOTable::DOM::TABLEDATA;

@ISA = qw(VOTable::DOM::Element);

sub new {
    my($class,$doc) = @_;
    $tdata = $doc->createElement("TABLEDATA");
    bless $tdata, $class;
}

#**
# print out the document up until just after the head tag of this
# TABLEDATA node.
# @param fh   a file handle.  Pass literal handles as \*FILE
##
sub printDocUntilHere {
    my($s,$fh) = @_;
    my $doc = $s->getOwnerDocument();
    $s->{StopPrint} = 1;
    $doc->printToFileHandle($fh);
}

#**
# print out the rest of this document
# @param fh   a file handle.
##
sub printDocToEnd {
    my($s,$fh) = @_;
    my $doc = $s->getOwnerDocument();
    $s->{StopPrint} = 0;
    $doc->printToFileHandle($fh);
}