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