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
|
------------------------------------------------------------------------------
-- XML/Ada - An XML suite for Ada95 --
-- --
-- Copyright (C) 2001-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Unicode.CES; use Unicode.CES;
with Unicode.CES.Utf32; use Unicode.CES.Utf32;
with Unicode.CES.Utf16; use Unicode.CES.Utf16;
with Unicode.CES.Utf8; use Unicode.CES.Utf8;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Input_Sources.File is
----------
-- Open --
----------
procedure Open (Filename : String; Input : out File_Input'Class) is
FD : File_Descriptor;
Length : Natural;
Cursor : Positive;
Actual_Length : Integer;
BOM : Bom_Type;
begin
-- Open the source FD, note that we open in binary mode, because there
-- is no point in wasting time on text translation when it is not
-- required.
FD := Open_Read (Filename, Binary);
-- Raise Name_Error if file cannot be found
if FD = Invalid_FD then
Raise_Exception
(Name_Error'Identity, "Could not open " & Filename);
end if;
Length := Integer (File_Length (FD));
-- If the file is empty, we just create a reader that will not return
-- any character. This will fail later on when the XML document is
-- parsed, anyway.
if Length = 0 then
Input.Buffer := new String (1 .. 1);
Input.Index := 2;
Close (FD);
return;
end if;
-- Allocate buffer
Input.Buffer := new String (1 .. Length);
-- On most systems, the loop below will be executed only once and the
-- file will be read in one chunk. However, some systems (e.g. VMS) have
-- file types that require one read per line, so read until we get the
-- Length bytes or until there are no more bytes to read.
Cursor := 1;
loop
Actual_Length := Read (FD, Input.Buffer (Cursor)'Address, Length);
Cursor := Cursor + Actual_Length;
exit when Actual_Length = Length or Actual_Length <= 0;
end loop;
Close (FD);
Read_Bom (Input.Buffer.all, Input.Prolog_Size, BOM);
case BOM is
when Utf32_LE =>
Set_Encoding (Input, Utf32_LE_Encoding);
when Utf32_BE =>
Set_Encoding (Input, Utf32_BE_Encoding);
when Utf16_LE =>
Set_Encoding (Input, Utf16_LE_Encoding);
when Utf16_BE =>
Set_Encoding (Input, Utf16_BE_Encoding);
when Ucs4_BE | Ucs4_LE | Ucs4_2143 | Ucs4_3412 =>
raise Invalid_Encoding;
when Utf8_All | Unknown =>
Set_Encoding (Input, Utf8_Encoding);
end case;
Input.Index := Input.Buffer'First + Input.Prolog_Size;
-- Do we have multiple instances of a BOM ? If yes, this is generally
-- valid except if the resulting encodings differ
declare
BOM2 : Bom_Type;
Len : Natural;
begin
Read_Bom
(Input.Buffer (Input.Index .. Input.Buffer'Last), Len, BOM2);
if BOM2 /= Unknown
and then BOM /= BOM2
then
Raise_Exception
(Mismatching_BOM'Identity,
"File specifies two different encodings");
end if;
-- In XML, we should apparently still report the second BOM
-- Input.Index := Input.Index + Len;
end;
-- Base file name should be used as the public Id
Set_Public_Id (Input, Filename);
Set_System_Id (Input, Filename);
end Open;
-----------
-- Close --
-----------
procedure Close (Input : in out File_Input) is
begin
Input_Sources.Close (Input_Source (Input));
Free (Input.Buffer);
Input.Index := Natural'Last;
end Close;
---------------
-- Next_Char --
---------------
procedure Next_Char
(From : in out File_Input;
C : out Unicode.Unicode_Char) is
begin
From.Es.Read (From.Buffer.all, From.Index, C);
C := From.Cs.To_Unicode (C);
exception
-- For a file input, an incomplete encoding is invalid.
when Incomplete_Encoding =>
raise Invalid_Encoding;
end Next_Char;
---------
-- Eof --
---------
function Eof (From : File_Input) return Boolean is
begin
return From.Buffer = null or else From.Index > From.Buffer'Length;
end Eof;
-------------------
-- Set_System_Id --
-------------------
procedure Set_System_Id (Input : in out File_Input; Id : Byte_Sequence) is
begin
if Is_Absolute_Path (Id) then
Set_System_Id (Input_Source (Input), Id);
else
Set_System_Id
(Input_Source (Input),
Normalize_Pathname (Id, Resolve_Links => False));
end if;
end Set_System_Id;
end Input_Sources.File;
|
