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 | |
---|