XML: Add subroutines to initialize a new tree and add elements.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
8ac5e49def
commit
b11a1fad58
352
sources/xml.F90
352
sources/xml.F90
@ -47,6 +47,13 @@ module XML
|
|||||||
! Module interfaces
|
! Module interfaces
|
||||||
! -----------------
|
! -----------------
|
||||||
!
|
!
|
||||||
|
interface XMLAddElement
|
||||||
|
module procedure XMLAddElementString
|
||||||
|
module procedure XMLAddElementInteger
|
||||||
|
module procedure XMLAddElementDouble
|
||||||
|
module procedure XMLAddElementFile
|
||||||
|
end interface
|
||||||
|
|
||||||
interface XMLGetElementValue
|
interface XMLGetElementValue
|
||||||
module procedure XMLGetElementValueInteger
|
module procedure XMLGetElementValueInteger
|
||||||
module procedure XMLGetElementValueDouble
|
module procedure XMLGetElementValueDouble
|
||||||
@ -81,8 +88,8 @@ module XML
|
|||||||
! --------------
|
! --------------
|
||||||
!
|
!
|
||||||
public :: XMLNode, XMLAttribute
|
public :: XMLNode, XMLAttribute
|
||||||
public :: XMLParseFile, XMLFreeTree, XMLSaveFile
|
public :: XMLParseFile, XMLInitTree, XMLFreeTree, XMLSaveTree
|
||||||
public :: XMLGetElementValue, XMLGetAttributeValue
|
public :: XMLAddElement, XMLGetElementValue, XMLGetAttributeValue
|
||||||
public :: XMLHasAttribute
|
public :: XMLHasAttribute
|
||||||
|
|
||||||
contains
|
contains
|
||||||
@ -184,6 +191,48 @@ contains
|
|||||||
!
|
!
|
||||||
end subroutine XMLParseFile
|
end subroutine XMLParseFile
|
||||||
|
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
! subroutine XMLTreeInit:
|
||||||
|
! ----------------------
|
||||||
|
!
|
||||||
|
! Description:
|
||||||
|
!
|
||||||
|
! Initializes a new XML Tree.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! node_ptr - Pointer to the XMLNode to be initialized;
|
||||||
|
! node_name - Name for the XMLNode;
|
||||||
|
! node_value - Optional value for the XMLNode;
|
||||||
|
!
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
subroutine XMLInitTree(root_ptr, version)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
||||||
|
character(len=*) , intent(in ), optional :: version
|
||||||
|
|
||||||
|
type(XMLAttribute), pointer :: attr_ptr
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
call XMLNodeInit(root_ptr, "AMUNFile")
|
||||||
|
if (present(version)) then
|
||||||
|
call XMLAttributeInit(attr_ptr, "version", trim(version))
|
||||||
|
else
|
||||||
|
call XMLAttributeInit(attr_ptr, "version", "1.0")
|
||||||
|
end if
|
||||||
|
call XMLAddAttribute(root_ptr, attr_ptr)
|
||||||
|
call XMLAttributeInit(attr_ptr, "byte_order", "LittleEndian")
|
||||||
|
call XMLAddAttribute(root_ptr, attr_ptr)
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
end subroutine XMLInitTree
|
||||||
|
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
! subroutine XMLFreeTree:
|
! subroutine XMLFreeTree:
|
||||||
@ -234,7 +283,7 @@ contains
|
|||||||
|
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
! subroutine XMLSaveFile:
|
! subroutine XMLSaveTree:
|
||||||
! ----------------------
|
! ----------------------
|
||||||
!
|
!
|
||||||
! Description:
|
! Description:
|
||||||
@ -248,7 +297,7 @@ contains
|
|||||||
!
|
!
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
subroutine XMLSaveFile(root_ptr, filename)
|
subroutine XMLSaveTree(root_ptr, filename)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
@ -260,13 +309,13 @@ contains
|
|||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
open(newunit=io, file=filename)
|
open(newunit=io, file=filename)
|
||||||
write (io,"(a)") "<?xml version='1.0' encoding='utf-8'?>"
|
write (io,"(a)") '<?xml version="1.0" encoding="utf-8"?>'
|
||||||
call XMLSaveNode(io, 1, root_ptr)
|
call XMLSaveNode(io, 1, root_ptr)
|
||||||
close(io)
|
close(io)
|
||||||
|
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
end subroutine XMLSaveFile
|
end subroutine XMLSaveTree
|
||||||
|
|
||||||
!=== PRIVATE SUBROUTINES AND FUNCTIONS ===
|
!=== PRIVATE SUBROUTINES AND FUNCTIONS ===
|
||||||
|
|
||||||
@ -797,6 +846,297 @@ contains
|
|||||||
!
|
!
|
||||||
end subroutine XMLGetAttribute
|
end subroutine XMLGetAttribute
|
||||||
|
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
! subroutine XMLAddElementString:
|
||||||
|
! ------------------------------
|
||||||
|
!
|
||||||
|
! Description:
|
||||||
|
!
|
||||||
|
! This subroutine adds a new element to the specified section of a XML tree.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! root_ptr - The root node of the XML tree;
|
||||||
|
! section_name - The section of the XML document where the element is located;
|
||||||
|
! element_name - The name of the XML element;
|
||||||
|
! element_value - The value of the element;
|
||||||
|
!
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
subroutine XMLAddElementString(root_ptr, section_name, &
|
||||||
|
element_name, element_value)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
||||||
|
character(len=*) , intent(in ) :: section_name, element_name
|
||||||
|
character(len=*) , intent(in ) :: element_value
|
||||||
|
|
||||||
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
||||||
|
type(XMLAttribute), pointer :: attr_ptr
|
||||||
|
|
||||||
|
logical :: found
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
found = .false.
|
||||||
|
node_ptr => root_ptr%children
|
||||||
|
do while (associated(node_ptr) .and. .not. found)
|
||||||
|
if (trim(node_ptr%name) == trim(section_name)) then
|
||||||
|
found = .true.
|
||||||
|
else
|
||||||
|
node_ptr => node_ptr%next
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
if (.not. found) then
|
||||||
|
call XMLNodeInit(node_ptr, section_name)
|
||||||
|
call XMLAddChild(root_ptr, node_ptr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
call XMLNodeInit(elem_ptr, element_name, element_value)
|
||||||
|
call XMLAttributeInit(attr_ptr, "type", "string")
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAddChild(node_ptr, elem_ptr)
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
end subroutine XMLAddElementString
|
||||||
|
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
! subroutine XMLAddElementInteger:
|
||||||
|
! -------------------------------
|
||||||
|
!
|
||||||
|
! Description:
|
||||||
|
!
|
||||||
|
! This subroutine adds a new element to the specified section of a XML tree.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! root_ptr - The root node of the XML tree;
|
||||||
|
! section_name - The section of the XML document where the element is located;
|
||||||
|
! element_name - The name of the XML element;
|
||||||
|
! element_value - The value of the element;
|
||||||
|
!
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
subroutine XMLAddElementInteger(root_ptr, section_name, &
|
||||||
|
element_name, element_value)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
||||||
|
character(len=*) , intent(in ) :: section_name, element_name
|
||||||
|
integer(kind=4) , intent(in ) :: element_value
|
||||||
|
|
||||||
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
||||||
|
type(XMLAttribute), pointer :: attr_ptr
|
||||||
|
|
||||||
|
logical :: found
|
||||||
|
character(len=64) :: str
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
found = .false.
|
||||||
|
node_ptr => root_ptr%children
|
||||||
|
do while (associated(node_ptr) .and. .not. found)
|
||||||
|
if (trim(node_ptr%name) == trim(section_name)) then
|
||||||
|
found = .true.
|
||||||
|
else
|
||||||
|
node_ptr => node_ptr%next
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
if (.not. found) then
|
||||||
|
call XMLNodeInit(node_ptr, section_name)
|
||||||
|
call XMLAddChild(root_ptr, node_ptr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
write(str,"(i0)") element_value
|
||||||
|
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
||||||
|
call XMLAttributeInit(attr_ptr, "type", "integer")
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAddChild(node_ptr, elem_ptr)
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
end subroutine XMLAddElementInteger
|
||||||
|
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
! subroutine XMLAddElementDouble:
|
||||||
|
! -------------------------------
|
||||||
|
!
|
||||||
|
! Description:
|
||||||
|
!
|
||||||
|
! This subroutine adds a new element to the specified section of a XML tree.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! root_ptr - The root node of the XML tree;
|
||||||
|
! section_name - The section of the XML document where the element is located;
|
||||||
|
! element_name - The name of the XML element;
|
||||||
|
! element_value - The value of the element;
|
||||||
|
!
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
subroutine XMLAddElementDouble(root_ptr, section_name, &
|
||||||
|
element_name, element_value)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
||||||
|
character(len=*) , intent(in ) :: section_name, element_name
|
||||||
|
real(kind=8) , intent(in ) :: element_value
|
||||||
|
|
||||||
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
||||||
|
type(XMLAttribute), pointer :: attr_ptr
|
||||||
|
|
||||||
|
logical :: found
|
||||||
|
character(len=64) :: str
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
found = .false.
|
||||||
|
node_ptr => root_ptr%children
|
||||||
|
do while (associated(node_ptr) .and. .not. found)
|
||||||
|
if (trim(node_ptr%name) == trim(section_name)) then
|
||||||
|
found = .true.
|
||||||
|
else
|
||||||
|
node_ptr => node_ptr%next
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
if (.not. found) then
|
||||||
|
call XMLNodeInit(node_ptr, section_name)
|
||||||
|
call XMLAddChild(root_ptr, node_ptr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
write(str,"(1es32.20)") element_value
|
||||||
|
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
||||||
|
call XMLAttributeInit(attr_ptr, "type", "double")
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAddChild(node_ptr, elem_ptr)
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
end subroutine XMLAddElementDouble
|
||||||
|
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
! subroutine XMLAddElementFile:
|
||||||
|
! ----------------------------
|
||||||
|
!
|
||||||
|
! Description:
|
||||||
|
!
|
||||||
|
! This subroutine is designed to add an XML element to an XML tree structure,
|
||||||
|
! with various attributes.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! root_ptr - A pointer to the root node of the XML tree;
|
||||||
|
! section_name - The name of the section or parent element under which
|
||||||
|
! the new XML element should be added;
|
||||||
|
! element_name - The name of the XML element to be added;
|
||||||
|
! element_value - The value associated with the XML element;
|
||||||
|
! element_dtype - The data type of the associated array;
|
||||||
|
! element_size - The size in bytes of an array stored in an associated
|
||||||
|
! binary file;
|
||||||
|
! element_dims - The shape or dimensions of the array stored in
|
||||||
|
! an associated binary file;
|
||||||
|
! element_digest - This argument is a string that specifies the type of
|
||||||
|
! digest used for the array data to ensure its integrity;
|
||||||
|
! element_hash - The digest or hash value of the uncompressed array data
|
||||||
|
! stored in the associated binary file;
|
||||||
|
! compressor - A string specifying the compression format used.
|
||||||
|
! compressed_size - The size of the compressed array.
|
||||||
|
! compressed_hash - The digest/hash value of the compressed array.
|
||||||
|
! encoder - A string specifying the data encoding format used.
|
||||||
|
!
|
||||||
|
!===============================================================================
|
||||||
|
!
|
||||||
|
subroutine XMLAddElementFile(root_ptr, section_name, element_name, &
|
||||||
|
element_value, element_dtype, element_size, &
|
||||||
|
element_dims, element_digest, element_hash, &
|
||||||
|
compressor, compressed_size, compressed_hash, &
|
||||||
|
encoder)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
type(XMLNode) , pointer , intent(inout) :: root_ptr
|
||||||
|
character(len=*) , intent(in ) :: section_name, element_name
|
||||||
|
character(len=*) , intent(in ) :: element_value, element_dtype
|
||||||
|
integer(kind=8) , intent(in ) :: element_size
|
||||||
|
integer, dimension(:) , intent(in ) :: element_dims
|
||||||
|
character(len=*) , intent(in ) :: element_digest, element_hash
|
||||||
|
integer(kind=8) , optional, intent(in ) :: compressed_size
|
||||||
|
character(len=*), optional, intent(in ) :: compressor, compressed_hash, &
|
||||||
|
encoder
|
||||||
|
|
||||||
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
||||||
|
type(XMLAttribute), pointer :: attr_ptr
|
||||||
|
|
||||||
|
logical :: found
|
||||||
|
character(len=64) :: str
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
found = .false.
|
||||||
|
node_ptr => root_ptr%children
|
||||||
|
do while (associated(node_ptr) .and. .not. found)
|
||||||
|
if (trim(node_ptr%name) == trim(section_name)) then
|
||||||
|
found = .true.
|
||||||
|
else
|
||||||
|
node_ptr => node_ptr%next
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
if (.not. found) then
|
||||||
|
call XMLNodeInit(node_ptr, section_name)
|
||||||
|
call XMLAddChild(root_ptr, node_ptr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
call XMLNodeInit(elem_ptr, element_name, element_value)
|
||||||
|
call XMLAttributeInit(attr_ptr, "type", "string")
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAttributeInit(attr_ptr, "data_type", element_dtype)
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
write(str,"(i0)") element_size
|
||||||
|
call XMLAttributeInit(attr_ptr, "size", trim(adjustl(str)))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
write(str,"(8(i0,1x))") element_dims
|
||||||
|
call XMLAttributeInit(attr_ptr, "dimensions", trim(adjustl(str)))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAttributeInit(attr_ptr, "digest_type", trim(element_digest))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
call XMLAttributeInit(attr_ptr, "digest", trim(element_hash))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
if (present(compressor)) then
|
||||||
|
call XMLAttributeInit(attr_ptr, "compression_format", trim(compressor))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
if (present(compressed_size)) then
|
||||||
|
write(str,"(i0)") compressed_size
|
||||||
|
call XMLAttributeInit(attr_ptr, "compressed_size", trim(adjustl(str)))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
end if
|
||||||
|
if (present(compressed_hash)) then
|
||||||
|
call XMLAttributeInit(attr_ptr, "compressed_digest", &
|
||||||
|
trim(compressed_hash))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
if (present(encoder)) then
|
||||||
|
call XMLAttributeInit(attr_ptr, "data_encoder", trim(encoder))
|
||||||
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||||
|
end if
|
||||||
|
call XMLAddChild(node_ptr, elem_ptr)
|
||||||
|
|
||||||
|
!-------------------------------------------------------------------------------
|
||||||
|
!
|
||||||
|
end subroutine XMLAddElementFile
|
||||||
|
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
! subroutine XMLGetElementValueDouble:
|
! subroutine XMLGetElementValueDouble:
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user