XML.f90

Go to the documentation of this file.

!======================================================================
!     Module supporting the inport of XML files.
!     This file is part of the EQuUs package. (for details see: http://eqt.elte.hu/equus/home)
!     Copyright (C) 2016 Peter Rakyta, Ph.D.
!
!     This program is free software: you can redistribute it and/or modify
!     it under the terms of the GNU General Public License as published by
!     the Free Software Foundation, either version 3 of the License, or
!     (at your option) any later version.
! 
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program.  If not, see http://www.gnu.org/licenses/.
!     
!======================================================================
#ifndef MAX_PROP_LENGTH
#define MAX_PROP_LENGTH 100
#endif



MODULE equus_xml

! DESCRIPTION:
type, public :: attrib
! The name of the property
  character(len=MAX_PROP_LENGTH) :: name
! The value of the property
  character(len=MAX_PROP_LENGTH) :: value
end type


! DESCRIPTION:
type, public :: xmlnode
! The localname of the XML node
  character(len=MAX_PROP_LENGTH) :: localname
! The level of the subnode relative to the root
  integer :: subnodelevel
! The array of the attributes 
  TYPE( attrib ), pointer :: attrs(:) => null()
! An array of XML subnodes
  TYPE( xmlnode ), pointer :: subnodes(:) => null()
! pointer to the parent node
  TYPE( xmlnode ), pointer :: parentnode => null()
! The value stored in the XML node
  character(len=:), pointer :: value => null()
end type



!****************************************************************      
  CONTAINS
!****************************************************************

!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  function hassubnodes( cXMLnode )

    TYPE(xmlnode) :: cxmlnode
    logical :: hassubnodes

    ! converting subnodes/value
    if (ASSOCIATED(cxmlnode%subnodes)) then
        hassubnodes = .true.
    else
        hassubnodes = .false.
    end if

  end function hassubnodes




!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  subroutine deallocatenode(node)
    TYPE( xmlnode ) :: node

      if (ASSOCIATED(node%subnodes)) then
        deallocate(node%subnodes)
      end if

      if (ASSOCIATED(node%attrs)) then
        deallocate(node%attrs)
      end if

      if (ASSOCIATED(node%parentnode)) then
        deallocate(node%parentnode)
      end if 

      if (ASSOCIATED(node%value)) then
        deallocate(node%value)
      end if 
 
  end subroutine deallocatenode

!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  subroutine copynode(source, dest)
    TYPE( xmlnode ) :: source  
    TYPE( xmlnode ) :: dest

      if (ASSOCIATED(source%attrs)) then
        dest%attrs => source%attrs
      end if

      if (ASSOCIATED(source%subnodes)) then
        dest%subnodes => source%subnodes
      end if

      if (ASSOCIATED(source%parentnode)) then
        dest%parentnode => source%parentnode
      end if 

      if (ASSOCIATED(source%value)) then
        dest%value => source%value
      end if 
 
      dest%subnodelevel = source%subnodelevel
      dest%localname = source%localname



  end subroutine copynode

!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  subroutine printnodewithsubnodes(node)
    TYPE( xmlnode ) :: node
    integer idx


    call printnode(node)

    if (ASSOCIATED(node%subnodes)) then
    else
      print *, "The node has no subnodes."
    end if

  end subroutine printnodewithsubnodes



!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  subroutine printnode(node)
    TYPE( xmlnode ) :: node

    integer idx

      print *, " "
      print *, "**********************"
      print *, "Printing content of an XML node"
      print *, "localname: ", trim(node%localname)
      print *, "subnodelevel: ", node%subnodelevel

      if (ASSOCIATED(node%attrs)) then
        print *, "attributes:"
        do idx = 1, SIZE(node%attrs, 1)
          print *, idx, "    ", trim(node%attrs(idx)%name), ": ", trim(node%attrs(idx)%value)
        end do
      end if

      if (ASSOCIATED(node%value)) then
        print *, "The value stored in the node: ", trim(node%value)
      end if

      if (ASSOCIATED(node%subnodes)) then
        print *, "Number of subnodes: ", SIZE(node%subnodes, 1)
        do idx = 1, SIZE(node%subnodes, 1)
          call printnodewithsubnodes(node%subnodes(idx))
        end do
      end if


  end subroutine printnode


!-------------------------------------------------------------------------------------------------
! DESCRIPTION:
  subroutine addsubnode(node, subnode)
    TYPE( xmlnode ) :: subnode  
    TYPE( xmlnode ) :: node
    TYPE( xmlnode ), pointer :: subnodes_tmp(:)

    integer elementNum

    if (.not.ASSOCIATED(node%subnodes)) then
      allocate(node%subnodes(1))
      call copynode(subnode, node%subnodes(1))
      return
    end if


    elementnum = SIZE( node%subnodes, 1)
    allocate( subnodes_tmp(elementnum) )

    do idx = 1, elementnum
      call copynode(node%subnodes(idx), subnodes_tmp(idx))
    end do

    deallocate( node%subnodes )
    allocate( node%subnodes(elementnum+1) )
    do idx = 1, elementnum
      call copynode(subnodes_tmp(idx), node%subnodes(idx))
    end do

    deallocate( subnodes_tmp )  

    call copynode(subnode, node%subnodes(elementnum+1))

! XML node containing subnodes should not contain any value
    node%value => null()

 

  end subroutine addsubnode






END MODULE