[6] | 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 |
---|