[6] | 1 | module m_dom_element |
---|
| 2 | |
---|
| 3 | use m_dom_types |
---|
| 4 | use m_dom_namednodemap |
---|
| 5 | use m_dom_nodelist |
---|
| 6 | use m_dom_attribute |
---|
| 7 | use m_dom_document |
---|
| 8 | use m_dom_debug |
---|
| 9 | use m_dom_node |
---|
| 10 | use m_strings |
---|
| 11 | |
---|
| 12 | private |
---|
| 13 | |
---|
| 14 | !------------------------------------------------------- |
---|
| 15 | ! METHODS FOR ELEMENT NODES |
---|
| 16 | !------------------------------------------------------- |
---|
| 17 | public :: getTagName |
---|
| 18 | public :: getElementsByTagName |
---|
| 19 | public :: getAttribute |
---|
| 20 | public :: getAttributeNode |
---|
| 21 | public :: setAttribute |
---|
| 22 | public :: setAttributeNode |
---|
| 23 | public :: removeAttribute |
---|
| 24 | public :: normalize !--- combines adjacent text nodes ---! |
---|
| 25 | |
---|
| 26 | CONTAINS |
---|
| 27 | |
---|
| 28 | !----------------------------------------------------------- |
---|
| 29 | ! METHODS FOR ELEMENT NODES |
---|
| 30 | !----------------------------------------------------------- |
---|
| 31 | function getTagName(element) |
---|
| 32 | |
---|
| 33 | type(fnode), intent(in) :: element |
---|
| 34 | type(string) :: getTagName |
---|
| 35 | |
---|
| 36 | if (element % nodeType == ELEMENT_NODE) then |
---|
| 37 | getTagName = element % nodeName |
---|
| 38 | else |
---|
| 39 | getTagName = '' |
---|
| 40 | endif |
---|
| 41 | |
---|
| 42 | end function getTagName |
---|
| 43 | |
---|
| 44 | !----------------------------------------------------------- |
---|
| 45 | function getElementsByTagName(element, tag) result(nodelist) |
---|
| 46 | type(fnode), pointer :: element |
---|
| 47 | character(len=*), intent(in) :: tag |
---|
| 48 | type(fnodeList), pointer :: nodelist |
---|
| 49 | |
---|
| 50 | type(fnode), pointer :: np |
---|
| 51 | |
---|
| 52 | nodelist => null() |
---|
| 53 | |
---|
| 54 | np => element |
---|
| 55 | if (dom_debug) print *, "Going into search for tag: ", trim(tag) |
---|
| 56 | call search(np) |
---|
| 57 | |
---|
| 58 | CONTAINS |
---|
| 59 | |
---|
| 60 | recursive subroutine search(np) |
---|
| 61 | type(fnode), pointer :: np |
---|
| 62 | |
---|
| 63 | type(string) :: name |
---|
| 64 | |
---|
| 65 | ! |
---|
| 66 | ! Could replace the calls to helper methods by direct lookups of node |
---|
| 67 | ! components to make it faster. |
---|
| 68 | ! |
---|
| 69 | do |
---|
| 70 | if (.not. associated(np)) exit |
---|
| 71 | select case(np%nodeType) |
---|
| 72 | |
---|
| 73 | case(DOCUMENT_NODE) |
---|
| 74 | ! special case ... search its children |
---|
| 75 | if (hasChildNodes(np)) call search(getFirstChild(np)) |
---|
| 76 | ! will exit for lack of siblings |
---|
| 77 | case(ELEMENT_NODE) |
---|
| 78 | |
---|
| 79 | name = getNodeName(np) |
---|
| 80 | if (dom_debug) print *, "exploring node: ", char(name) |
---|
| 81 | if ((tag == "*") .or. (tag == name)) then |
---|
| 82 | call append(nodelist,np) |
---|
| 83 | if (dom_debug) print *, "found match ", nodelist%length |
---|
| 84 | endif |
---|
| 85 | if (hasChildNodes(np)) call search(getFirstChild(np)) |
---|
| 86 | |
---|
| 87 | case default |
---|
| 88 | |
---|
| 89 | ! do nothing |
---|
| 90 | |
---|
| 91 | end select |
---|
| 92 | |
---|
| 93 | if (associated(np,element)) exit ! no siblings of element... |
---|
| 94 | np => getNextSibling(np) |
---|
| 95 | |
---|
| 96 | enddo |
---|
| 97 | |
---|
| 98 | end subroutine search |
---|
| 99 | |
---|
| 100 | end function getElementsByTagName |
---|
| 101 | |
---|
| 102 | !----------------------------------------------------------- |
---|
| 103 | |
---|
| 104 | function getAttribute(element, name) |
---|
| 105 | |
---|
| 106 | type(fnode), intent(in) :: element |
---|
| 107 | character(len=*), intent(in) :: name |
---|
| 108 | type(string) :: getAttribute |
---|
| 109 | |
---|
| 110 | type(fnode), pointer :: nn |
---|
| 111 | |
---|
| 112 | getAttribute = "" ! as per specs, if not found |
---|
| 113 | if (element % nodeType /= ELEMENT_NODE) RETURN |
---|
| 114 | nn => getNamedItem(element%attributes,name) |
---|
| 115 | if (.not. associated(nn)) RETURN |
---|
| 116 | |
---|
| 117 | getAttribute = nn%nodeValue |
---|
| 118 | |
---|
| 119 | |
---|
| 120 | end function getAttribute |
---|
| 121 | |
---|
| 122 | !----------------------------------------------------------- |
---|
| 123 | |
---|
| 124 | function getAttributeNode(element, name) |
---|
| 125 | |
---|
| 126 | type(fnode), intent(in) :: element |
---|
| 127 | type(fnode), pointer :: getAttributeNode |
---|
| 128 | character(len=*), intent(in) :: name |
---|
| 129 | |
---|
| 130 | getAttributeNode => null() ! as per specs, if not found |
---|
| 131 | if (element % nodeType /= ELEMENT_NODE) RETURN |
---|
| 132 | getAttributeNode => getNamedItem(element%attributes,name) |
---|
| 133 | |
---|
| 134 | end function getAttributeNode |
---|
| 135 | |
---|
| 136 | !----------------------------------------------------------- |
---|
| 137 | |
---|
| 138 | subroutine setAttributeNode(element, newattr) |
---|
| 139 | type(fnode), pointer :: element |
---|
| 140 | type(fnode), pointer :: newattr |
---|
| 141 | |
---|
| 142 | type(fnode), pointer :: dummy |
---|
| 143 | |
---|
| 144 | if (element % nodeType /= ELEMENT_NODE) then |
---|
| 145 | if (dom_debug) print *, "not an element node in setAttributeNode..." |
---|
| 146 | RETURN |
---|
| 147 | endif |
---|
| 148 | |
---|
| 149 | dummy => setNamedItem(element%attributes,newattr) |
---|
| 150 | |
---|
| 151 | end subroutine setAttributeNode |
---|
| 152 | |
---|
| 153 | !------------------------------------------------------------------- |
---|
| 154 | subroutine setAttribute(element, name, value) |
---|
| 155 | type(fnode), pointer :: element |
---|
| 156 | character(len=*), intent(in) :: name |
---|
| 157 | character(len=*), intent(in) :: value |
---|
| 158 | |
---|
| 159 | type(fnode), pointer :: newattr |
---|
| 160 | |
---|
| 161 | newattr => createAttribute(name) |
---|
| 162 | call setValue(newattr,value) |
---|
| 163 | call setAttributeNode(element,newattr) |
---|
| 164 | |
---|
| 165 | end subroutine setAttribute |
---|
| 166 | |
---|
| 167 | !----------------------------------------------------------- |
---|
| 168 | |
---|
| 169 | subroutine removeAttribute(element, name) |
---|
| 170 | type(fnode), pointer :: element |
---|
| 171 | character(len=*), intent(in) :: name |
---|
| 172 | |
---|
| 173 | type(fnode), pointer :: dummy |
---|
| 174 | |
---|
| 175 | if (element % nodeType /= ELEMENT_NODE) RETURN |
---|
| 176 | if (.not. associated(element%attributes)) RETURN |
---|
| 177 | |
---|
| 178 | dummy => removeNamedItem(element%attributes,name) |
---|
| 179 | |
---|
| 180 | end subroutine removeAttribute |
---|
| 181 | |
---|
| 182 | !----------------------------------------------------------- |
---|
| 183 | recursive subroutine normalize(element) |
---|
| 184 | type(fnode), pointer :: element |
---|
| 185 | |
---|
| 186 | type(fnode), pointer :: np, ghost |
---|
| 187 | logical :: first |
---|
| 188 | |
---|
| 189 | type(fnode), pointer :: head |
---|
| 190 | |
---|
| 191 | first = .true. ! next Text node will be first |
---|
| 192 | |
---|
| 193 | if (dom_debug) print *, "Normalizing: ", trim(element%nodeName) |
---|
| 194 | np => element%firstChild |
---|
| 195 | ! |
---|
| 196 | do |
---|
| 197 | if (.not. associated(np)) exit |
---|
| 198 | select case(np%nodeType) |
---|
| 199 | |
---|
| 200 | case(TEXT_NODE) |
---|
| 201 | if (first) then |
---|
| 202 | if (dom_debug) print *, "normalize: found first in chain" |
---|
| 203 | head => np |
---|
| 204 | first = .false. |
---|
| 205 | np => getNextSibling(np) |
---|
| 206 | else ! a contiguous text node |
---|
| 207 | if (dom_debug) print *, "normalize: found second in chain" |
---|
| 208 | head%nodeValue = head%nodeValue // np%nodeValue |
---|
| 209 | head%nextSibling => np%nextSibling |
---|
| 210 | if (associated(np,np%parentNode%lastChild)) then |
---|
| 211 | np%parentNode%lastChild => head |
---|
| 212 | head%nextSibling => null() |
---|
| 213 | else |
---|
| 214 | np%nextSibling%previousSibling => head |
---|
| 215 | endif |
---|
| 216 | ghost => np |
---|
| 217 | np => getNextSibling(np) |
---|
| 218 | call destroyNode(ghost) |
---|
| 219 | endif |
---|
| 220 | |
---|
| 221 | case(ELEMENT_NODE) |
---|
| 222 | |
---|
| 223 | first = .true. |
---|
| 224 | if (dom_debug) print *, "element sibling: ", trim(np%nodeName) |
---|
| 225 | if (hasChildNodes(np)) call normalize(np) |
---|
| 226 | np => getNextSibling(np) |
---|
| 227 | |
---|
| 228 | case default |
---|
| 229 | |
---|
| 230 | ! do nothing, just mark that we break the chain of text nodes |
---|
| 231 | if (dom_debug) print *, "other sibling: ", trim(np%nodeName) |
---|
| 232 | first = .true. |
---|
| 233 | np => getNextSibling(np) |
---|
| 234 | |
---|
| 235 | end select |
---|
| 236 | |
---|
| 237 | enddo |
---|
| 238 | |
---|
| 239 | end subroutine normalize |
---|
| 240 | |
---|
| 241 | |
---|
| 242 | end module m_dom_element |
---|