1 | module m_dom_utils |
---|
2 | |
---|
3 | use m_dom_types |
---|
4 | use m_dom_element |
---|
5 | use m_dom_document |
---|
6 | use m_dom_node |
---|
7 | use m_dom_namednodemap |
---|
8 | use m_dom_debug |
---|
9 | use m_strings |
---|
10 | |
---|
11 | use flib_wxml |
---|
12 | |
---|
13 | public :: dumpTree |
---|
14 | public :: xmlize |
---|
15 | |
---|
16 | private |
---|
17 | |
---|
18 | CONTAINS |
---|
19 | |
---|
20 | subroutine dumpTree(startNode) |
---|
21 | |
---|
22 | type(fnode), pointer :: startNode |
---|
23 | |
---|
24 | character(len=50) :: indent = " " |
---|
25 | integer :: indent_level |
---|
26 | type(string) :: s |
---|
27 | |
---|
28 | indent_level = 0 |
---|
29 | |
---|
30 | call dump2(startNode) |
---|
31 | |
---|
32 | contains |
---|
33 | |
---|
34 | recursive subroutine dump2(input) |
---|
35 | type(fnode), pointer :: input |
---|
36 | type(fnode), pointer :: temp |
---|
37 | temp => input |
---|
38 | do while(associated(temp)) |
---|
39 | s = getNodeName(temp) |
---|
40 | write(*,'(3a,i3)') indent(1:indent_level), & |
---|
41 | char(s), " of type ", & |
---|
42 | getNodeType(temp) |
---|
43 | if (hasChildNodes(temp)) then |
---|
44 | indent_level = indent_level + 3 |
---|
45 | call dump2(getFirstChild(temp)) |
---|
46 | indent_level = indent_level - 3 |
---|
47 | endif |
---|
48 | temp => getNextSibling(temp) |
---|
49 | enddo |
---|
50 | |
---|
51 | end subroutine dump2 |
---|
52 | |
---|
53 | end subroutine dumpTree |
---|
54 | !---------------------------------------------------------------- |
---|
55 | |
---|
56 | subroutine xmlize(startNode,fname) |
---|
57 | |
---|
58 | type(fnode), pointer :: startNode |
---|
59 | character(len=*), intent(in) :: fname |
---|
60 | |
---|
61 | type(xmlf_t) :: xf |
---|
62 | type(string) :: s, sv, sn ! to avoid memory leaks |
---|
63 | |
---|
64 | call xml_OpenFile(fname,xf) |
---|
65 | call dump_xml(startNode) |
---|
66 | call xml_Close(xf) |
---|
67 | |
---|
68 | contains |
---|
69 | |
---|
70 | recursive subroutine dump_xml(input) |
---|
71 | type(fnode), pointer :: input |
---|
72 | ! |
---|
73 | ! Just this node and its descendants, no siblings. |
---|
74 | ! Of course, the document node has only children... |
---|
75 | ! |
---|
76 | type(fnode), pointer :: node, attr |
---|
77 | type(fnamedNodeMap), pointer :: attr_map |
---|
78 | integer :: i |
---|
79 | |
---|
80 | node => input |
---|
81 | do |
---|
82 | if (.not. associated(node)) exit |
---|
83 | select case (getNodeType(node)) |
---|
84 | |
---|
85 | case (DOCUMENT_NODE) |
---|
86 | |
---|
87 | call xml_AddXMLDeclaration(xf) |
---|
88 | if (hasChildNodes(node)) call dump_xml(getFirstChild(node)) |
---|
89 | |
---|
90 | case (ELEMENT_NODE) |
---|
91 | |
---|
92 | s = getNodeName(node) |
---|
93 | call xml_NewElement(xf,char(s)) |
---|
94 | attr_map => getAttributes(node) |
---|
95 | do i = 0, getLength(attr_map) - 1 |
---|
96 | attr => item(attr_map,i) |
---|
97 | sn = getNodeName(attr) |
---|
98 | sv = getNodeValue(attr) |
---|
99 | call xml_AddAttribute(xf, char(sn),char(sv)) |
---|
100 | enddo |
---|
101 | if (hasChildNodes(node)) call dump_xml(getFirstChild(node)) |
---|
102 | s = getNodeName(node) |
---|
103 | call xml_EndElement(xf,char(s)) |
---|
104 | |
---|
105 | case (TEXT_NODE) |
---|
106 | |
---|
107 | s = getNodeValue(node) |
---|
108 | call xml_AddPcdata(xf,char(s)) |
---|
109 | |
---|
110 | case (CDATA_SECTION_NODE) |
---|
111 | |
---|
112 | s = getNodeValue(node) |
---|
113 | call xml_AddCdataSection(xf,char(s)) |
---|
114 | |
---|
115 | case (COMMENT_NODE) |
---|
116 | |
---|
117 | s = getNodeValue(node) |
---|
118 | call xml_AddComment(xf,char(s)) |
---|
119 | |
---|
120 | end select |
---|
121 | if (associated(node,StartNode)) exit ! In case we request the |
---|
122 | ! dumping of a single element, |
---|
123 | ! do not do siblings |
---|
124 | node => getNextSibling(node) |
---|
125 | enddo |
---|
126 | |
---|
127 | end subroutine dump_xml |
---|
128 | |
---|
129 | end subroutine xmlize |
---|
130 | |
---|
131 | end module m_dom_utils |
---|