source: XMLF90/src/sax/m_entities.f90 @ 295

Last change on this file since 295 was 6, checked in by ymipsl, 12 years ago

Import des sources XMLF90

File size: 3.2 KB
Line 
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
10private
11
12integer, parameter, private      :: MAX_REPLACEMENT_SIZE = 200
13!
14type, private :: entity_t
15 character(len=40)                     :: code
16 character(len=MAX_REPLACEMENT_SIZE)   :: replacement
17end type entity_t
18
19integer, parameter, private                          ::  N_ENTITIES  = 5
20
21type(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     
30public :: code_to_str , entity_filter
31
32CONTAINS
33
34subroutine code_to_str(code,str,status)
35character(len=*), intent(in)  :: code
36character(len=*), intent(out) :: str
37integer, intent(out)          :: status         
38integer :: i
39
40integer   :: number, ll
41character(len=4)  :: fmtstr
42
43status = -1
44do 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
50enddo
51!
52! Replace character references  (but only within the range of the
53! char intrinsic !!)
54!
55if (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
69endif
70
71end subroutine code_to_str
72
73!----------------------------------------------------------------
74!
75! Replaces entity references in buf1 and creates a new buffer buf2.
76!
77subroutine entity_filter(buf1,buf2,status,message)
78type(buffer_t), intent(in)    :: buf1
79type(buffer_t), intent(out)   :: buf2
80integer, intent(out)          :: status
81character(len=*), intent(out) :: message
82!
83! Replaces entity references by their value
84!
85integer :: i, k, len1
86character(len=MAX_BUFF_SIZE)           :: s1
87character(len=1)                       :: c
88character(len=MAX_REPLACEMENT_SIZE)    :: repl
89
90call buffer_to_character(buf1,s1)        !! Avoid allocation of temporary
91len1 = len(buf1)
92
93i = 1
94status = 0
95
96call reset_buffer(buf2)
97
98do
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
125enddo
126
127end subroutine entity_filter
128
129end module m_entities
130
131
132
133
134
Note: See TracBrowser for help on using the repository browser.