1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292 | -----------------------------------------------------------------------------
--
-- Copyright 2004 Björn Persson.
--
-- This library is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License, version 2, as published
-- by the Free Software Foundation.
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be covered
-- by the General Public License. This exception does not however invalidate
-- any other reasons why the executable file might be covered by the General
-- Public License.
--
----------------------------------------------------------------------------
pragma License (Modified_Gpl);
pragma Ada_2022;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Interfaces.C;
with Ada.Strings.Unbounded;
with System.Storage_Elements;
with AdaCL.OS.Low_Level;
package body AdaCL.EAstrings.Transcoding is
---------------------
-- Iconv Interface --
---------------------
-- typedef void *iconv_t;
subtype Iconv_T is Converter;
type Byte_Access is access all Interfaces.Unsigned_8;
type Constant_Byte_Access is access constant Interfaces.Unsigned_8;
-- iconv_t iconv_open(const char *tocode, const char *fromcode);
function Iconv_Open (To, From : in String) return Iconv_T;
pragma Import (C, Iconv_Open, "iconv_open");
-- size_t iconv(iconv_t cd,
-- char **inbuf, size_t *inbytesleft,
-- char **outbuf, size_t *outbytesleft);
function Iconv
(CD : in Iconv_T;
Inbuf : access Constant_Byte_Access;
Inbytesleft : access Interfaces.C.size_t;
Outbuf : access Byte_Access;
Outbytesleft : access Interfaces.C.size_t)
return Interfaces.C.size_t;
pragma Import (C, Iconv, "iconv");
-- int iconv_close(iconv_t cd);
procedure Iconv_Close (CD : in Iconv_T);
pragma Import (C, Iconv_Close, "iconv_close");
-- I really hope these error codes are the same numbers everywhere.
EINVAL : constant Integer := 22;
EILSEQ : constant Integer := 84;
E2BIG : constant Integer := 7;
---------------------
-- Close_Converter --
---------------------
procedure Close_Converter (Item : in out Converter) is
begin
if Item /= Null_Converter then
Iconv_Close (Item);
Item := Null_Converter;
end if;
end Close_Converter;
-------------
-- Convert --
-------------
procedure Convert
(State : in Converter;
Source : in Byte_Sequence;
Target : out Byte_Sequence;
Source_Last : out Natural; -- index of last source byte converted
Target_Last : out Natural; -- index of last target byte in use
Cause : out Conversion_Stop_Cause)
is
Result : Interfaces.C.size_t;
Source_Pointer : aliased Constant_Byte_Access;
Target_Pointer : aliased Byte_Access;
Source_Bytes_Left : aliased Interfaces.C.size_t;
Target_Bytes_Left : aliased Interfaces.C.size_t;
Error_Code : Integer;
use Interfaces.C;
begin
Source_Pointer := Source (1)'Unchecked_Access;
Source_Bytes_Left := size_t (Source'Length);
Target_Pointer := Target (1)'Unchecked_Access;
Target_Bytes_Left := size_t (Target'Length);
Result :=
Iconv
(State,
Source_Pointer'Access,
Source_Bytes_Left'Access,
Target_Pointer'Access,
Target_Bytes_Left'Access);
if Result = -1 then
Error_Code := AdaCL.OS.Low_Level.Errno;
case Error_Code is
when EINVAL =>
Cause := Incomplete;
when EILSEQ =>
Cause := Inconvertible;
when E2BIG =>
Cause := Target_Full;
when others =>
Ada.Exceptions.Raise_Exception
(Other_Error'Identity,
"errno =" & Integer'Image (Error_Code));
end case;
else
Cause := All_Done;
end if;
Source_Last := Source'Last - Integer (Source_Bytes_Left);
Target_Last := Target'Last - Integer (Target_Bytes_Left);
end Convert;
--------------------
-- Open_Converter --
--------------------
function Open_Converter
(From, To : Character_Encoding)
return Converter
is
use Ada.Characters.Latin_1, Ada.Strings.Unbounded;
use type System.Storage_Elements.Integer_Address;
Result : Iconv_T;
Error_Code : Integer;
begin
Result :=
Iconv_Open
(To => To_String (Name (To)) & NUL,
From => To_String (Name (From)) & NUL);
-- The iconv_open function returns a freshly allocated conversion
-- descriptor. In case of error, it sets errno and returns
-- (iconv_t)(-1).
if Result = Iconv_T (System.Storage_Elements.To_Address (-1)) then
Error_Code := AdaCL.OS.Low_Level.Errno;
if Error_Code = EINVAL then
Ada.Exceptions.Raise_Exception
(Unsupported_Conversion'Identity,
To_String (Name (To)) & " -> " & To_String (Name (From)));
else
Ada.Exceptions.Raise_Exception
(Other_Error'Identity,
"errno =" & Integer'Image (Error_Code));
end if;
else
return Result;
end if;
end Open_Converter;
---------------------
-- Reset_Converter --
---------------------
procedure Reset_Converter (Item : in Converter) is
Trash : Interfaces.C.size_t;
pragma Unreferenced (Trash);
Null_1 : aliased Constant_Byte_Access := null;
Null_2 : aliased Byte_Access := null;
Zero : aliased Interfaces.C.size_t := 0;
begin
Trash :=
Iconv
(Item,
Null_1'Access,
Zero'Access,
Null_2'Access,
Zero'Access);
end Reset_Converter;
---------------
-- Transcode --
---------------
function Transcode
(Source : in EAstring;
New_Encoding : in Character_Encoding)
return EAstring
is
begin
if New_Encoding = Source.Encoding then
return Source;
elsif Source.Last = 0 then
return
(AF.Controlled with
Encoding => New_Encoding,
Reference => Null_Sequence'Access,
Last => 0);
else
declare
Transcoded : EAstring;
State : Iconv_T;
Chunk_Size : Natural := Natural'Max (Source.Last, 4);
Result : Interfaces.C.size_t;
Source_Pointer : aliased Constant_Byte_Access;
Target_Pointer : aliased Byte_Access;
Source_Bytes_Left : aliased Interfaces.C.size_t;
Target_Bytes_Left : aliased Interfaces.C.size_t;
Error_Code : Integer;
use Interfaces.C, Ada.Strings.Unbounded;
use type System.Storage_Elements.Integer_Address;
begin
Transcoded.Encoding := New_Encoding;
State :=
Iconv_Open
(To => To_String (Name (New_Encoding)) &
Ada.Characters.Latin_1.NUL,
From => To_String (Name (Source.Encoding)) &
Ada.Characters.Latin_1.NUL);
-- The iconv_open function returns a freshly allocated conversion
-- descriptor. In case of error, it sets errno and returns
-- (iconv_t)(-1).
if State =
Iconv_T (System.Storage_Elements.To_Address (-1))
then
Error_Code := AdaCL.OS.Low_Level.Errno;
if Error_Code = EINVAL then
Ada.Exceptions.Raise_Exception
(Unsupported_Conversion'Identity,
To_String (Name (New_Encoding)) &
" -> " &
To_String (Name (Source.Encoding)));
else
Ada.Exceptions.Raise_Exception
(Other_Error'Identity,
"errno =" & Integer'Image (Error_Code));
end if;
end if;
Source_Pointer := Source.Reference.all (1)'Access;
Source_Bytes_Left := size_t (Source.Last);
loop
Realloc_For_Chunk (Transcoded, Chunk_Size);
Target_Pointer :=
Transcoded.Reference.all (Transcoded.Last + 1)'Access;
Target_Bytes_Left :=
size_t (Transcoded.Reference'Length - Transcoded.Last);
Result :=
Iconv
(State,
Source_Pointer'Access,
Source_Bytes_Left'Access,
Target_Pointer'Access,
Target_Bytes_Left'Access);
if Result = -1 then
Error_Code := AdaCL.OS.Low_Level.Errno;
case Error_Code is
when EINVAL =>
raise Incomplete_Byte_Sequence;
when EILSEQ =>
raise Conversion_Impossible;
when E2BIG =>
null; -- target too small, Source_Bytes_Left > 0
when others =>
Ada.Exceptions.Raise_Exception
(Other_Error'Identity,
"errno =" & Integer'Image (Error_Code));
end case;
end if;
declare
New_Last : constant Natural :=
Transcoded.Reference'Length -
Integer (Target_Bytes_Left);
begin
if New_Last = Transcoded.Last then
-- There wasn't room for even the first character.
-- Allocate larger chunks.
Chunk_Size := Chunk_Size * 2;
end if;
Transcoded.Last := New_Last;
end;
exit when Source_Bytes_Left = 0;
end loop;
Iconv_Close (State);
return Transcoded;
end;
end if;
end Transcode;
end AdaCL.EAstrings.Transcoding;
|