source: XMLF90/src/dom/m_dom_element.f90

Last change on this file was 6, checked in by ymipsl, 13 years ago

Import des sources XMLF90

File size: 6.7 KB
Line 
1module m_dom_element
2
3use m_dom_types
4use m_dom_namednodemap
5use m_dom_nodelist
6use m_dom_attribute
7use m_dom_document
8use m_dom_debug
9use m_dom_node
10use m_strings
11
12private
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
26CONTAINS
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
242end module m_dom_element
Note: See TracBrowser for help on using the repository browser.