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