Permalink
Fetching contributors…
Cannot retrieve contributors at this time
87 lines (74 sloc) 2.78 KB
module m_common_entity_expand
#ifndef DUMMYLIB
use fox_m_fsys_array_str, only: str_vs, vs_str
use m_common_entities, only: expand_char_entity
use m_common_error, only: error_stack, add_error
use m_common_namecheck, only: checkName, checkCharacterEntityReference, &
checkRepCharEntityReference
use m_common_struct, only: xml_doc_state
implicit none
private
public :: expand_entity_value_alloc
! This does the first level of expansion of the contents of an entity
! reference, for storage during processing. Only character references
! are expanded.
contains
function expand_entity_value_alloc(repl, xds, stack) result(repl_new)
!perform expansion of character entity references
! check that no parameter entities are present
! and check that all general entity references are well-formed.
!before storing it.
!
! This is only ever called from the SAX parser
! (might it be called from WXML?)
! so input & output is with character arrays, not strings.
character, dimension(:), intent(in) :: repl
type(xml_doc_state), intent(in) :: xds
type(error_stack), intent(inout) :: stack
character, dimension(:), pointer :: repl_new
character, dimension(size(repl)) :: repl_temp
integer :: i, i2, j
allocate(repl_new(0))
if (index(str_vs(repl),'%')/=0) then
call add_error(stack, "Not allowed % in internal subset general entity value")
return
endif
i = 1
i2 = 1
do
if (i>size(repl)) exit
if (repl(i)=='&') then
j = index(str_vs(repl(i+1:)),';')
if (j==0) then
call add_error(stack, "Not allowed bare & in entity value")
return
elseif (checkName(str_vs(repl(i+1:i+j-1)), xds%xml_version)) then
repl_temp(i2:i2+j) = repl(i:i+j)
i = i + j + 1
i2 = i2 + j + 1
! For SAX, we need to be able to represent the character:
elseif (checkRepCharEntityReference(str_vs(repl(i+1:i+j-1)), xds%xml_version)) then
!if it is ascii then
repl_temp(i2:i2) = vs_str(expand_char_entity(str_vs(repl(i+1:i+j-1))))
i = i + j + 1
i2 = i2 + 1
elseif (checkCharacterEntityReference(str_vs(repl(i+1:i+j-1)), xds%xml_version)) then
! We can't represent it. Issue an error and stop.
call add_error(stack, "Unable to digest character entity reference in entity value, sorry.")
return
else
call add_error(stack, "Invalid entity reference in entity value")
return
endif
else
repl_temp(i2) = repl(i)
i = i + 1
i2 = i2 + 1
endif
enddo
deallocate(repl_new)
allocate(repl_new(i2-1))
repl_new = repl_temp(:i2-1)
end function expand_entity_value_alloc
#endif
end module m_common_entity_expand