1module xmlf90_dom_namednodemap 2! 3! This is basically a dictionary module, but written with the 4! DOM node structure in mind. 5! 6use xmlf90_dom_types 7use xmlf90_strings 8 9implicit none 10 11private 12 !------------------------------------------------------- 13 ! METHODS FOR NAMEDNODEMAPS 14 !------------------------------------------------------- 15 public :: getNamedItem 16 public :: setNamedItem 17 public :: removeNamedItem 18 19 public :: item 20 public :: getLength 21 public :: append 22 23 interface append 24 module procedure append_nnm 25 end interface 26 27 interface item 28 module procedure item_nnm 29 end interface 30 31 interface getLength 32 module procedure getLength_nnm 33 end interface 34 35CONTAINS 36 37 function item_nnm(namedNodeMap, i) 38 39 integer, intent(in) :: i 40 type(fnamedNodeMap), pointer :: namedNodeMap 41 type(fnode), pointer :: item_nnm 42 43 type(fnamedNode), pointer :: nnp 44 45 integer :: n 46 47 item_nnm => null() ! In case there is no such item 48 if (.not. associated(namedNodeMap)) RETURN 49 50 nnp => namedNodeMap%head 51 n = -1 52 do 53 if (.not. associated(nnp)) exit 54 n = n + 1 55 if (n == i) then 56 item_nnm => nnp%node 57 exit 58 endif 59 nnp => nnp%next 60 enddo 61 62 end function item_nnm 63 64 !----------------------------------------------------------- 65 66 function getLength_nnm(namedNodeMap) 67 68 type(fnamedNodeMap), pointer :: namedNodeMap 69 integer :: getLength_nnm 70 71 getLength_nnm = 0 72 if (.not. associated(namedNodeMap)) return 73 74 getLength_nnm = namedNodeMap % length 75 76 end function getLength_nnm 77 78 !----------------------------------------------------------- 79 80 81 subroutine append_nnm(nodeMap,node) 82 type(fnamednodeMap), pointer :: nodeMap 83 type(fnode), pointer :: node 84 85 if (.not. associated(nodeMap)) then 86 allocate(nodeMap) 87 nodeMap%length = 1 88 allocate(nodeMap%head) 89 nodeMap%head%name = node%nodeName 90 nodeMap%head%node => node 91 nodeMap%tail => nodeMap%head 92 else 93 allocate(nodeMap%tail%next) 94 nodeMap%tail%next%node => node 95 nodeMap%tail%next%name = node%nodeName 96 nodeMap%tail => nodeMap%tail%next 97 nodeMap%length = nodeMap%length + 1 98 endif 99 100 end subroutine append_nnm 101 102 !----------------------------------------------------------- 103 104 function getNamedItem(namedNodeMap, name) 105 106 type(fnamedNodeMap), pointer :: namedNodeMap 107 character(len=*), intent(in) :: name 108 type(fnode), pointer :: getNamedItem 109 110 type(fnamedNode), pointer :: nnp 111 112 getNamedItem => null() 113 if (.not. associated(namedNodeMap)) return 114 115 nnp => namedNodeMap%head 116 do while (associated(nnp)) 117 if (nnp%name == name) then 118 getNamedItem => nnp%node 119 exit ! one or zero nodes with a given name 120 endif 121 nnp => nnp%next 122 enddo 123 124 end function getNamedItem 125 126 127 function setNamedItem(namedNodeMap, node) 128 129!!AG: Do we need to clone the node ? 130 131 type(fnamedNodeMap), pointer :: namedNodeMap 132 type(fnode), pointer :: node 133 type(fnode), pointer :: setNamedItem 134 135 type(fnamedNode), pointer :: nnp 136 137 if (.not. associated(namedNodeMap)) then 138 139 call append(namedNodeMap,node) 140 setNamedItem => node 141 142 else 143 144 nnp => namedNodeMap%head 145 do while (associated(nnp)) 146 if (nnp%name == node%nodeName) then 147 !setNamedItem => nnp%node 148 call destroyNode(nnp%node) 149 nnp%node => node 150 setNamedItem => node 151 return 152 endif 153 nnp => nnp%next 154 enddo 155 156 ! If not found, insert it at the end of the linked list 157 158 call append(namedNodeMap,node) 159 setNamedItem => node 160 endif 161 162 end function setNamedItem 163 164!------------------------------------------------------------ 165 function removeNamedItem(namedNodeMap, name) 166 167 type(fnamedNodeMap), pointer :: namedNodeMap 168 character(len=*), intent(in) :: name 169 type(fnode), pointer :: removeNamedItem 170 171 type(fnamedNode), pointer :: nnp, previous 172 173 removeNamedItem => null() 174 if (.not. associated(namedNodeMap)) return 175 176 previous => null() 177 nnp => namedNodeMap%head 178 do while (associated(nnp)) 179 if (nnp%name == name) then 180 removeNamedItem => nnp%node 181 if (associated(nnp,namedNodeMap%head)) then 182 ! we remove the first fnamedNode in the chain... 183 namedNodeMap%head => nnp%next 184 else if (.not. associated(nnp%next)) then 185 ! we remove the last fnamedNode in the chain 186 previous%next => null() 187 namedNodeMap%tail => previous 188 else 189 ! we remove a link in the middle of the chain 190 previous%next => nnp%next 191 endif 192 namedNodeMap%length = namedNodeMap%length - 1 193 deallocate(nnp) 194 EXIT ! one or zero nodes with a given name 195 endif 196 previous => nnp 197 nnp => nnp%next 198 enddo 199 !! Deallocate the entire dictionary, if it is empty 200 if (namedNodeMap%length == 0) then 201 deallocate(namedNodeMap) 202 end if 203 204 end function removeNamedItem 205 206 207end module xmlf90_dom_namednodemap 208