1module m_entities 2! 3! Entity management 4! 5! It deals with: 6! 1. The five standard entities (gt,lt,amp,apos,quot) 7! 2. Character entities (but only within the range of the char intrinsic) 8! 9use m_buffer 10use m_xml_error 11private 12 13integer, parameter, private :: MAX_REPLACEMENT_SIZE = 200 14! 15type, private :: entity_t 16 character(len=40) :: code 17 character(len=MAX_REPLACEMENT_SIZE) :: replacement 18end type entity_t 19 20integer, parameter, private :: N_ENTITIES = 5 21 22type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent = & 23 (/ & 24 entity_t("gt",">"), & 25 entity_t("lt","<"), & 26 entity_t("amp","&"), & 27 entity_t("apos","'"), & 28 entity_t("quot","""") & 29 /) 30 31public :: code_to_str , entity_filter 32 33CONTAINS 34 35subroutine code_to_str(code,str,status) 36character(len=*), intent(in) :: code 37character(len=*), intent(out) :: str 38integer, intent(out) :: status 39integer :: i 40 41integer :: number, ll 42character(len=4) :: fmtstr 43 44status = -1 45do i = 1, N_ENTITIES 46 if (code == predefined_ent(i)%code) then 47 str = predefined_ent(i)%replacement 48 status = 0 49 return 50 endif 51enddo 52! 53! Replace character references (but only within the range of the 54! char intrinsic !!) 55! 56if (code(1:1) == "#") then 57 if (code(2:2) == "x") then ! hex character reference 58 ll = len_trim(code(3:)) 59 write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")" 60 read(unit=code(3:),fmt=fmtstr) number 61 str = char(number) 62 status = 0 63 return 64 else ! decimal character reference 65 read(unit=code(2:),fmt=*) number 66 str = char(number) 67 status = 0 68 return 69 endif 70endif 71 72end subroutine code_to_str 73 74!---------------------------------------------------------------- 75! 76! Replaces entity references in buf1 and creates a new buffer buf2. 77! 78subroutine entity_filter(buf1,buf2) 79type(buffer_t), intent(in) :: buf1 80type(buffer_t), intent(out) :: buf2 81! 82! Replaces entity references by their value 83! 84integer :: i, k, len1 85character(len=MAX_BUFF_SIZE) :: s1 86character(len=1) :: c 87character(len=MAX_REPLACEMENT_SIZE) :: repl 88 89character(len=120) :: message 90integer :: status 91 92 93call buffer_to_character(buf1,s1) !! Avoid allocation of temporary 94len1 = len(buf1) 95 96i = 1 97 98call reset_buffer(buf2) 99 100do 101 if (i > len1) exit 102 c = s1(i:i) 103 if (c == "&") then 104 if (i+1 > len1) then 105 message= " Unmatched & in entity reference" 106 call general_error(trim(message),SEVERE_ERROR_CODE) 107 return 108 endif 109 k = index(s1(i+1:),";") 110 if (k == 0) then 111 message= " Unmatched & in entity reference" 112 call general_error(trim(message),SEVERE_ERROR_CODE) 113 return 114 endif 115 call code_to_str(s1(i+1:i+k-1),repl,status) 116 if (status /= 0) then 117 message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";" 118 call general_error(trim(message),WARNING_CODE) 119 else 120 call add_to_buffer(trim(repl),buf2) 121 endif 122 i = i + k + 1 123 else 124 call add_to_buffer(c,buf2) 125 i = i + 1 126 endif 127enddo 128 129end subroutine entity_filter 130 131end module m_entities 132 133 134 135 136 137