XML: Add subroutines to initialize a new tree and add elements.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2023-08-14 10:13:17 -03:00
parent 8ac5e49def
commit b11a1fad58

View File

@ -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: