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