source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90 @ 2281

module m_entities
!
! Entity management
!
! It deals with: 
!    1. The five standard entities (gt,lt,amp,apos,quot)
!    2. Character entities  (but only within the range of the char intrinsic)
!
use m_buffer
private

integer, parameter, private      :: MAX_REPLACEMENT_SIZE = 200
!
type, private :: entity_t
 character(len=40)                     :: code
 character(len=MAX_REPLACEMENT_SIZE)   :: replacement
end type entity_t

integer, parameter, private                          ::  N_ENTITIES  = 5

type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent =  &
      (/                  &
      entity_t("gt",">"), &
      entity_t("lt","<"),  &
      entity_t("amp","&"),  &
      entity_t("apos","'"),  &
      entity_t("quot","""")  &
      /)
      
public :: code_to_str , entity_filter

CONTAINS

subroutine code_to_str(code,str,status)
character(len=*), intent(in)  :: code
character(len=*), intent(out) :: str
integer, intent(out)          :: status         
integer :: i

integer   :: number, ll
character(len=4)  :: fmtstr

status = -1
do i = 1, N_ENTITIES
      if (code == predefined_ent(i)%code) then
         str = predefined_ent(i)%replacement
         status = 0
         return
      endif
enddo
!
! Replace character references  (but only within the range of the
! char intrinsic !!)
!
if (code(1:1) == "#") then
   if (code(2:2) == "x") then       ! hex character reference
      ll = len_trim(code(3:))
      write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")"
      read(unit=code(3:),fmt=fmtstr) number
      str = char(number)
      status = 0
      return
   else                             ! decimal character reference
      read(unit=code(2:),fmt=*) number
      str = char(number)
      status = 0
      return
   endif
endif

end subroutine code_to_str

!----------------------------------------------------------------
!
! Replaces entity references in buf1 and creates a new buffer buf2.
!
subroutine entity_filter(buf1,buf2,status,message)
type(buffer_t), intent(in)    :: buf1
type(buffer_t), intent(out)   :: buf2
integer, intent(out)          :: status
character(len=*), intent(out) :: message
!
! Replaces entity references by their value
!
integer :: i, k, len1
character(len=MAX_BUFF_SIZE)           :: s1
character(len=1)                       :: c
character(len=MAX_REPLACEMENT_SIZE)    :: repl

call buffer_to_character(buf1,s1)        !! Avoid allocation of temporary
len1 = len(buf1)

i = 1
status = 0

call reset_buffer(buf2)

do
   if (i > len1) exit
   c = s1(i:i)
   if (c == "&") then
      if (i+1 > len1) then
         status = -i
         message=  " Unmatched & in entity reference"
         return
      endif
      k = index(s1(i+1:),";")
      if (k == 0) then
         status = -i
         message=  " Unmatched & in entity reference"
         return
      endif
      call code_to_str(s1(i+1:i+k-1),repl,status)
      if (status /= 0) then
         status =  i     ! Could let it continue
         message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";"
      else
         call add_to_buffer(trim(repl),buf2)
      endif
      i = i + k + 1
   else
     call add_to_buffer(c,buf2)
     i = i + 1
   endif
enddo

end subroutine entity_filter

end module m_entities