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
|
||||
! -----------------
|
||||
!
|
||||
interface XMLAddElement
|
||||
module procedure XMLAddElementString
|
||||
module procedure XMLAddElementInteger
|
||||
module procedure XMLAddElementDouble
|
||||
module procedure XMLAddElementFile
|
||||
end interface
|
||||
|
||||
interface XMLGetElementValue
|
||||
module procedure XMLGetElementValueInteger
|
||||
module procedure XMLGetElementValueDouble
|
||||
@ -81,8 +88,8 @@ module XML
|
||||
! --------------
|
||||
!
|
||||
public :: XMLNode, XMLAttribute
|
||||
public :: XMLParseFile, XMLFreeTree, XMLSaveFile
|
||||
public :: XMLGetElementValue, XMLGetAttributeValue
|
||||
public :: XMLParseFile, XMLInitTree, XMLFreeTree, XMLSaveTree
|
||||
public :: XMLAddElement, XMLGetElementValue, XMLGetAttributeValue
|
||||
public :: XMLHasAttribute
|
||||
|
||||
contains
|
||||
@ -184,6 +191,48 @@ contains
|
||||
!
|
||||
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:
|
||||
@ -234,7 +283,7 @@ contains
|
||||
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine XMLSaveFile:
|
||||
! subroutine XMLSaveTree:
|
||||
! ----------------------
|
||||
!
|
||||
! Description:
|
||||
@ -248,7 +297,7 @@ contains
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine XMLSaveFile(root_ptr, filename)
|
||||
subroutine XMLSaveTree(root_ptr, filename)
|
||||
|
||||
implicit none
|
||||
|
||||
@ -260,13 +309,13 @@ contains
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
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)
|
||||
close(io)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine XMLSaveFile
|
||||
end subroutine XMLSaveTree
|
||||
|
||||
!=== PRIVATE SUBROUTINES AND FUNCTIONS ===
|
||||
|
||||
@ -797,6 +846,297 @@ contains
|
||||
!
|
||||
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:
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user