# -*-perl-*-
# $Id: xml.wrt 5355 2007-07-13 21:53:24Z mnodine $
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.

# Writer of internal docutils doctree structure (DOM) into XML.

=pod
=begin reST
=begin Description
This writer dumps out the internal Document Object Model (DOM, also
known as a doctree) as an XML file.  It is useful for checking the
results of the parser or transformations.  It recognizes no defines.
=end Description
=end reST
=cut

sub BEGIN {
    # My -W flags
    use vars qw();

    # Defaults for -W flags

    # Globals
    use vars qw(%QUOTE);
    %QUOTE = ('<'=>'lt', '>'=>'gt', '"', 'quot');
}

# Returns an equal sign and a quoted attribute from a list of attribute values
sub quote_attr {
    my (@attr) = @_;
    foreach (@attr) {
	s/([<>\"])/&$QUOTE{$1};/g;
	s/ /\\ /g;
    }
    qq(="@attr");
}

phase PROCESS {
    sub \#PCDATA = {
	my ($dom, $str) = @_;
	my $text = $dom->{text};
	$text =~ s/([\x00-\x09\x0b-\x1f\x7f-\xff\x{0100}-\x{ffff}])/sprintf '\u%04x', ord $1/ge;
	return $text;
    }

    sub mathml {
	my ($dom, $str) = @_;
	return $dom->{attr}{mathml} ? $dom->{attr}{mathml}->text . "\n" : $str;
    }

    sub .* = {
	my ($dom, $str) = @_;
	my $attr = defined $dom->{attr} ?
	    join('',map(qq( $_) .
			(! defined $dom->{attr}{$_} ? '' :
			 ref($dom->{attr}{$_}) eq 'ARRAY' ?
#				   qq(="@{$dom->{attr}{$_}}") :
			 quote_attr(@{$dom->{attr}{$_}}) :
			 quote_attr($dom->{attr}{$_})),
			sort keys %{$dom->{attr}})) : '';
	my $tag = $dom->tag;
	return $str eq '' ? "<$tag$attr/>\n" : "<$tag$attr>\n$str</$tag>\n";
    }
}