lib/Text/Restructured/Writer/LibXML.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

package Text::Restructured::Writer::LibXML; 
use strict;
use warnings;
use XML::LibXML;
use Encode;
 
$Text::Restructured::Writer::LibXML::VERSION='0.01';
 
=head1 NAME
 
Text::Restructured::Writer::LibXML
 
=head1 SYNOPSIS
 
  use Text::Restructured;
  use Text::Restructured::Writer::LibXML;
 
  my $parser=Text::Restructured->new($opts,'gino');
  my $dudom=$parser->Parse($input,$filename);
  my $xdoc=Text::Restructured::Writer::LibXML->new->ProcessDOM($dudom);
 
=head1 DESCRIPTION
 
This module implements a "Writer" for L<Text::Restructured>, that
instead of returning a string, returns a L<XML::LibXML> DOM.
 
The DOM will have non-namespaced elements according to the docutils
vocabulary, and namespcaed elements according to the MathML
vocabulary.
 
This is probably the fastest way to transform a
L<Text::Restructured::DOM> structure into a proper XML DOM.
 
=head1 METHODS
 
=head2 C<new>
 
Returns a new object.
 
=cut
 
sub new {
    my ($class)=@_;
    return bless {},$class;
}
 
=head2 I<xml_dom>C<= ProcessDOM(>I<docutils_dom>C<)>
 
Given an object of type L<Text::Restructured::DOM>, processes it
recursively and builds an XML DOM into a new document. Returns the
document, or dies trying.
 
=cut
 
sub ProcessDOM {
    my ($self,$dudom)=@_;
    my $xdoc=XML::LibXML->createDocument();
    $xdoc->setDocumentElement(_docutils2xml($dudom,$xdoc));
    return $xdoc;
}
 
my $MATHML='http://www.w3.org/1998/Math/MathML';
 
sub _mathml2xml {
    my ($mnode,$xdoc)=@_;
 
    if ($mnode->isText) {
        return $xdoc->createTextNode(_ensure_char_semantic($mnode->nodeValue));
    }
 
 
    my @children=map {_mathml2xml($_,$xdoc)}
        $mnode->childNodes();
 
    my $elem=$xdoc->createElementNS($MATHML,_ensure_char_semantic($mnode->nodeName));
    for my $attname ($mnode->attributeList) {
        next if $attname eq 'xmlns';
        $elem->setAttribute(_ensure_char_semantic($attname),
                            _ensure_char_semantic($mnode->attribute($attname)))
    }
 
    $elem->appendChild($_) for @children;
 
    return $elem;
}
 
sub _docutils2xml {
    my ($dunode,$xdoc)=@_;
 
    if ($dunode->{tag} eq '#PCDATA') {
        return $xdoc->createTextNode(_ensure_char_semantic($dunode->{text} || ''));
    }
 
    if ($dunode->{tag} eq 'mathml') {
        return _mathml2xml($dunode->{attr}{mathml},$xdoc);
    }
 
    my @children=map {_docutils2xml($_,$xdoc)}
        @{ $dunode->{content} || [] };
 
    my $elem=$xdoc->createElement(_ensure_char_semantic($dunode->{tag}));
 
    if (defined $dunode->{attr}) {
        while (my ($attname,$attval)=each %{$dunode->{attr}}) {
            if (! defined $attval) {
                $attval='';
            }
            elsif (ref($attval) eq 'ARRAY') {
                $attval=join ' ',map {_ensure_char_semantic($_)} @$attval;
            }
            $elem->setAttribute(_ensure_char_semantic($attname),
                                _ensure_char_semantic($attval));
        }
    }
    $elem->appendChild($_) for @children;
 
    return $elem;
}
 
sub _ensure_char_semantic {
    my ($str)=@_;
 
    return $str if utf8::is_utf8($str);
 
    return decode('utf8',$str);
}
 
1;