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