source: XMLF90/src/dom/m_dom_types.f90 @ 53

Last change on this file since 53 was 6, checked in by ymipsl, 12 years ago

Import des sources XMLF90

File size: 6.4 KB
Line 
1Module m_dom_types
2
3  use m_strings
4
5  implicit none
6
7  private
8
9  !-------------------------------------------------------   
10  ! A GENERIC NODE
11  !-------------------------------------------------------   
12  type, public :: fnode
13     type(string)         :: nodeName   
14     type(string)         :: nodeValue   
15!!!     character(len=200)    :: nodeName  = ""
16!!!     character(len=200)    :: nodeValue = ""
17     integer              :: nc              = 0 
18     integer              :: nodeType        = 0
19     type(fnode), pointer :: parentNode      => null()
20     type(fnodeList), pointer :: childNodes  => null()  ! New
21     type(fnode), pointer :: firstChild      => null()
22     type(fnode), pointer :: lastChild       => null()
23     type(fnode), pointer :: previousSibling => null()
24     type(fnode), pointer :: nextSibling     => null()
25     type(fnode), pointer :: ownerDocument   => null()
26     type(fnamedNodeMap), pointer :: attributes => null()
27  end type fnode
28
29  !-----------------------------------------------------------
30  !  ONE WAY TO IMPLEMENT A NAMEDNODEMAP  (dictionary)
31  !-----------------------------------------------------------
32
33  ! Linked list of name/node pairs, with overall length variable
34
35  type, public :: fnamedNode
36     type(string)                   :: name
37!!!     character(len=100)            :: name
38     type(fnode), pointer          :: node => null()
39     type(fnamedNode), pointer     :: next => null()
40  end type fnamedNode
41
42  type, public :: fnamedNodeMap
43     integer :: length = 0
44     type(fnamedNode), pointer  :: head => null()
45     type(fnamedNode), pointer  :: tail => null()
46  end type fnamedNodeMap
47
48  !-----------------------------------------------------------
49  !  ONE WAY TO IMPLEMENT A NODELIST
50  !-----------------------------------------------------------
51
52  type, public :: flistNode
53     type(fnode), pointer          :: node => null()
54     type(flistNode), pointer      :: next => null()
55  end type flistNode
56
57  type, public :: fnodeList
58     integer                      :: length = 0
59     type(flistNode), pointer     :: head => null()
60     type(flistNode), pointer     :: tail => null()
61  end type fnodeList
62
63!========================================================================
64  integer, save, private          :: allocated_nodes = 0
65!========================================================================
66
67  !-------------------------------------------------------   
68  ! NODETYPES
69  !-------------------------------------------------------   
70  integer, parameter, public :: ELEMENT_NODE                = 1
71  integer, parameter, public :: ATTRIBUTE_NODE              = 2
72  integer, parameter, public :: TEXT_NODE                   = 3
73  integer, parameter, public :: CDATA_SECTION_NODE          = 4
74  integer, parameter, public :: ENTITY_REFERENCE_NODE       = 5
75  integer, parameter, public :: ENTITY_NODE                 = 6
76  integer, parameter, public :: PROCESSING_INSTRUCTION_NODE = 7
77  integer, parameter, public :: COMMENT_NODE                = 8
78  integer, parameter, public :: DOCUMENT_NODE               = 9
79  integer, parameter, public :: DOCUMENT_TYPE_NODE          = 10
80  integer, parameter, public :: DOCUMENT_FRAGMENT_NODE      = 11
81  integer, parameter, public :: NOTATION_NODE               = 12
82
83  public :: node_class
84  public :: createNode
85  public :: destroyNode
86  public :: destroyNamedNodeMap
87  public :: destroyNodeList
88  public :: getNumberofAllocatedNodes
89
90CONTAINS
91
92  function getNumberofAllocatedNodes() result(n)
93    integer   :: n
94
95    n = allocated_nodes
96  end function getNumberofAllocatedNodes
97
98!--------------------------------------------------------------
99  function createNode() result(node)
100    type(fnode), pointer  :: node
101
102    allocate(node)
103    allocated_nodes = allocated_nodes + 1
104
105  end function createNode
106!--------------------------------------------------------------
107
108  function node_class(nodetype) result(class)
109    integer, intent(in) :: nodetype
110    character(len=10)  ::     class
111
112    select case(nodetype)
113    case(ELEMENT_NODE)
114       class = "element"
115    case(ATTRIBUTE_NODE)
116       class = "attribute"
117    case(TEXT_NODE)
118       class = "text"
119    case(COMMENT_NODE)
120       class = "comment"
121    case(DOCUMENT_NODE)
122       class = "document"
123    end select
124  end function node_class
125
126  subroutine destroyNamedNodeMap(nodemap)
127    type(fnamedNodeMap), pointer :: nodemap
128
129    type(fnamednode), pointer  :: nnp
130    type(fnode), pointer       :: ghost
131   
132    if (.not. associated(nodemap)) return
133    nnp => nodemap%head
134    do while (associated(nnp))
135       call unstring(nnp%name)
136       ghost => nnp%node
137       nnp => nnp%next
138       call destroyNode(ghost)      ! We might not want to really destroy
139    enddo
140  end subroutine destroyNamedNodeMap
141
142  subroutine destroyNodeList(nodelist)
143    type(fnodeList), pointer :: nodelist
144
145    type(flistnode), pointer   :: p
146    type(fnode), pointer       :: ghost
147   
148    if (.not. associated(nodelist)) return
149    p => nodelist%head
150    do while (associated(p))
151       ghost => p%node
152       p => p%next
153       call destroyNode(ghost)      ! We might not want to really destroy
154    enddo
155  end subroutine destroyNodeList
156
157  recursive subroutine destroyNode(node)
158    type(fnode), pointer  :: node
159   
160    type(fnode), pointer  :: np, ghost
161   
162    np => node
163    do while (associated(np))
164       if (associated(np%firstChild)) then
165          call destroyNode(np%firstChild)
166       endif
167       if (associated(np%attributes)) call destroyNamedNodeMap(np%attributes)
168       call unstring(np%nodeName)
169       call unstring(np%nodeValue)
170       if (associated(np%previousSibling)) & 
171                np%previousSibling%nextSibling => np%nextSibling
172       if (associated(np%nextSibling)) & 
173                np%nextSibling%previousSibling => np%previousSibling
174       if (associated(np%parentNode)) then
175          if (associated(np%parentNode%firstChild,np)) &
176               np%parentNode%firstChild => null()
177          if (associated(np%parentNode%lastChild,np)) &
178               np%parentNode%lastChild => null()
179       endif
180       if (associated(np,node)) then   
181          deallocate(np)
182          allocated_nodes = allocated_nodes - 1
183          EXIT                           ! do not destroy siblings
184       else
185          ghost => np
186          np => np%nextSibling
187          deallocate(ghost)
188          allocated_nodes = allocated_nodes - 1
189       endif
190    enddo
191    node => null()     ! superfluous ?
192  end subroutine destroyNode
193
194end module m_dom_types
195
Note: See TracBrowser for help on using the repository browser.