#!perl -w

=pod

=head1 NAME

Neuron::XML::Write - Write an XML file and DTD

=head1 SYNOPSIS

Neuron::XML::Write provides functions to output a neural morphology to an XML
file.

=head1 FUNCTIONS

=over 0

=item *
writeXMLHeader(I<header>, I<file>);

writes data from array of hashes into XML file linearly. Data must also be
written in order to gain a correct XML file.

=item *
writeXMLData(I<neuron>, I<file>);

writes data from array of hashes into XML file linearly.

=item *
writeXMLDataTree(I<neuron>, I<file>);

writes data from array of hashes into XML file, preserving tree structure.

=back

=head1 INTERNAL FUNCTIONS

=over 0

=item *
writeDTD();

writes the XML DTD to "neuron.dtd"

=back

=head1 AUTHOR

Gunther Schmidl <gschmidl@gmx.at>

=cut

package Neuron::XML::Write;
use strict;
use warnings;
no warnings 'recursion';

# prepare variable export

use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(writeXMLHeader writeXMLData writeXMLDataTree);
@EXPORT_OK = qw();
$VERSION = 1.00;






#==============================================================================
#
# writeDTD() - write DTD for the XML file to "neuron.dtd".
#
#==============================================================================

sub writeDTD()
{
    open FILE, ">neuron.dtd" || die "neuron.dtd could not be opened: $!";
    print FILE<<"EOF";
<!ELEMENT morphology  (description?, neuron+)                         >
<!ELEMENT description (line*)                                         >
<!ELEMENT line        EMPTY                                           >
<!ELEMENT compartment (flag, coordinates, diameter, parent, children?)>
<!ELEMENT flag        (#PCDATA)                                       >
<!ELEMENT coordinates (x, y, z)                                       >
<!ELEMENT x           (#PCDATA)                                       >
<!ELEMENT y           (#PCDATA)                                       >
<!ELEMENT z           (#PCDATA)                                       >
<!ELEMENT diameter    (#PCDATA)                                       >
<!ELEMENT parent      (#PCDATA)                                       >
<!ELEMENT children    (neuron*)                                       >

<!ATTLIST line        name   CDATA #REQUIRED>
<!ATTLIST line        value  CDATA #REQUIRED>
<!ATTLIST compartment number CDATA #REQUIRED>
EOF
    close FILE;
}






#==============================================================================
#
# writeXMLHeader(hash, file) - write header from hash to file.
# Writing a header without actual data is not possible.
#
#==============================================================================

sub writeXMLHeader(%, $)
{
    writeDTD();

    my($desc, $val);

    open FILE, ">$_[1]" || die "$_[1] could not be opened: $!";

    # write XML header stuff
    print FILE "<?xml version=\"1.0\" ?>\n";
    print FILE "<!DOCTYPE morphology SYSTEM \"neuron.dtd\">\n";
    print FILE "<morphology>\n";
    print FILE "<description>\n";

    # go through all header nodes
    while (($desc,$val) = each %{$_[0]})
    {
        $val =~ s/&/and/;
        print FILE "    <line name=\"$desc\" value=\"$val\" />\n";
    }
    print FILE "</description>\n";
    close FILE;
    return 0;
}






#==============================================================================
#
# writeXMLData(array, file) - write data from 2d array to file.
# Will append to already existing file in case a header is wanted.
#
#==============================================================================

sub writeXMLData(@, $)
{
    writeDTD() unless -e "neuron.dtd";      # write only if it doesn't exist

    my ($i, @n);

    @n = @{$_[0]};

    if (-e $_[1])                           # file exists
    {
        open FILE, ">>$_[1]" || die "$_[1] could not be opened: $!";
    }
    else
    {
        #write XML header stuff
        open FILE, ">$_[1]" || die "$_[1] could not be opened: $!";
        print FILE "<?xml version=\"1.0\" ?>\n";
        print FILE "<!DOCTYPE morphology SYSTEM \"neuron.dtd\">\n";
        print FILE "<morphology>\n";
    }

    # write data for each neuron sequentially
    for ($i = 1; $i <= $#n; $i++)
    {
        print FILE "<compartment number=\"$n[$i]->{'number'}\">\n";
        print FILE "    <flag>$n[$i]->{'flag'}</flag>\n";
        print FILE "    <coordinates>\n";
        print FILE "        <x>$n[$i]->{'x'}</x>\n";
        print FILE "        <y>$n[$i]->{'y'}</y>\n";
        print FILE "        <z>$n[$i]->{'z'}</z>\n";
        print FILE "    </coordinates>\n";
        print FILE "    <diameter>$n[$i]->{'d'}</diameter>\n";
        print FILE "    <parent>$n[$i]->{'parent'}</parent>\n";
        print FILE "</compartment>\n";
    }
    print FILE "</morphology>";
    close FILE;
    return 0;
}






#==============================================================================
#
# writeXMLDataTree(array, file) - write data from 2d array to file in original
# tree structure. Will append to already existing file in case a header is
# wanted.
#
#==============================================================================

sub recurse
{
    my $n = $_[0];
    # write data for this neuron
    print FILE "<compartment number=\"$n->{'number'}\">\n";
    print FILE "<flag>$n->{'flag'}</flag>\n";
    print FILE "<coordinates>\n";
    print FILE "<x>$n->{'x'}</x>\n";
    print FILE "<y>$n->{'y'}</y>\n";
    print FILE "<z>$n->{'z'}</z>\n";
    print FILE "</coordinates>\n";
    print FILE "<diameter>$n->{'d'}</diameter>\n";
    print FILE "<parent>$n->{'parent'}</parent>\n";

    if ($n->{'kids'})                       # not a bachelor node
    {
        my @kids = @{ $n->{'kids'} };
        print FILE "<children>";
        for my $kid (@kids) { recurse($kid); }
        print FILE "</children>";
    }
    print FILE "</compartment>\n";
}


sub writeXMLDataTree(@, $)
{
    writeDTD() unless -e "neuron.dtd";      # write only if it doesn't exist

    my @n = @{$_[0]};                       # get first node

    if (-e $_[1])
    {
        open FILE, ">>$_[1]" || die "$_[1] could not be opened: $!";
    }
    else
    {
        # write XML header stuff
        open FILE, ">$_[1]" || die "$_[1] could not be opened: $!";
        print FILE "<?xml version=\"1.0\" ?>\n";
        print FILE "<!DOCTYPE morphology SYSTEM \"neuron.dtd\">\n";
        print FILE "<morphology>\n";
    }

    recurse($n[1]);                         # go depth-first through all nodes

    print FILE "</morphology>\n";
    close FILE;
    return 0;
}