1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                              Tools Component                             --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2013, Vadim Godunko <vgodunko@gmail.com>                     --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 3791 $ $Date: 2013-02-23 23:12:10 +0400 (Sat, 23 Feb 2013) $
43------------------------------------------------------------------------------
44with Ada.Containers.Hashed_Sets;
45
46with League.Characters;
47with League.Strings.Hash;
48with League.String_Vectors;
49with XML.SAX.Attributes;
50with XML.SAX.Content_Handlers;
51with XML.SAX.Input_Sources.Streams.Files;
52with XML.SAX.Simple_Readers;
53
54package body CSMIB.Parser is
55
56   use type League.Strings.Universal_String;
57
58   package String_Sets is
59     new Ada.Containers.Hashed_Sets
60          (League.Strings.Universal_String,
61           League.Strings.Hash,
62           League.Strings."=");
63
64   type CSMIB_Parser is
65     limited new XML.SAX.Content_Handlers.SAX_Content_Handler with record
66      Text      : League.Strings.Universal_String;
67      Collect   : Boolean := False;
68      In_Record : Boolean := False;
69      MIB       : Positive;
70      Aliases   : League.String_Vectors.Universal_String_Vector;
71      All_Names : String_Sets.Set;
72   end record;
73
74   overriding procedure Characters
75    (Self    : in out CSMIB_Parser;
76     Text    : League.Strings.Universal_String;
77     Success : in out Boolean);
78
79   overriding procedure End_Element
80    (Self           : in out CSMIB_Parser;
81     Namespace_URI  : League.Strings.Universal_String;
82     Local_Name     : League.Strings.Universal_String;
83     Qualified_Name : League.Strings.Universal_String;
84     Success        : in out Boolean);
85
86   overriding function Error_String
87    (Self : CSMIB_Parser) return League.Strings.Universal_String;
88
89   overriding procedure Start_Element
90    (Self           : in out CSMIB_Parser;
91     Namespace_URI  : League.Strings.Universal_String;
92     Local_Name     : League.Strings.Universal_String;
93     Qualified_Name : League.Strings.Universal_String;
94     Attributes     : XML.SAX.Attributes.SAX_Attributes;
95     Success        : in out Boolean);
96
97   function Normalize
98    (Item : League.Strings.Universal_String)
99       return League.Strings.Universal_String;
100
101   Alias_Element  : constant League.Strings.Universal_String
102     := League.Strings.To_Universal_String ("alias");
103   Name_Element   : constant League.Strings.Universal_String
104     := League.Strings.To_Universal_String ("name");
105   Record_Element : constant League.Strings.Universal_String
106     := League.Strings.To_Universal_String ("record");
107   Value_Element  : constant League.Strings.Universal_String
108     := League.Strings.To_Universal_String ("value");
109
110   ----------------
111   -- Characters --
112   ----------------
113
114   overriding procedure Characters
115    (Self    : in out CSMIB_Parser;
116     Text    : League.Strings.Universal_String;
117     Success : in out Boolean) is
118   begin
119      if Self.Collect then
120         Self.Text.Append (Text);
121      end if;
122   end Characters;
123
124   -----------------
125   -- End_Element --
126   -----------------
127
128   overriding procedure End_Element
129    (Self           : in out CSMIB_Parser;
130     Namespace_URI  : League.Strings.Universal_String;
131     Local_Name     : League.Strings.Universal_String;
132     Qualified_Name : League.Strings.Universal_String;
133     Success        : in out Boolean)
134   is
135      Name : League.Strings.Universal_String;
136
137   begin
138      if Qualified_Name = Alias_Element then
139         if Self.In_Record then
140            Name := Normalize (Self.Text);
141
142            if not Self.All_Names.Contains (Name) then
143               Self.All_Names.Insert (Name);
144               Self.Aliases.Append (Name);
145            end if;
146         end if;
147
148         Self.Text.Clear;
149         Self.Collect := False;
150
151      elsif Qualified_Name = Name_Element then
152         if Self.In_Record then
153            Name := Normalize (Self.Text);
154
155            if Self.All_Names.Contains (Name) then
156               --  Name of the character set is in conflict with alias of
157               --  someone else character set.
158
159               raise Constraint_Error;
160            end if;
161
162            Self.All_Names.Insert (Name);
163            Self.Aliases.Append (Name);
164         end if;
165
166         Self.Text.Clear;
167         Self.Collect := False;
168
169      elsif Qualified_Name = Record_Element then
170         for J in 1 .. Self.Aliases.Length loop
171            MIBs.Append ((Self.Aliases.Element (J), Self.MIB));
172         end loop;
173
174         Self.In_Record := False;
175         Self.Aliases.Clear;
176
177      elsif Qualified_Name = Value_Element then
178         Self.MIB :=
179           Positive'Wide_Wide_Value (Self.Text.To_Wide_Wide_String);
180         Self.Text.Clear;
181         Self.Collect := False;
182      end if;
183   end End_Element;
184
185   ------------------
186   -- Error_String --
187   ------------------
188
189   overriding function Error_String
190    (Self : CSMIB_Parser) return League.Strings.Universal_String is
191   begin
192      return League.Strings.Empty_Universal_String;
193   end Error_String;
194
195   ---------------
196   -- Normalize --
197   ---------------
198
199   function Normalize
200    (Item : League.Strings.Universal_String)
201       return League.Strings.Universal_String
202   is
203      use type League.Characters.Universal_Character;
204
205      Aux   : League.Strings.Universal_String;
206      Digit : Boolean := False;
207
208   begin
209      for J in 1 .. Item.Length loop
210         case Item.Element (J).To_Wide_Wide_Character is
211            when 'A' .. 'Z' =>
212               Aux.Append (Item.Element (J).Simple_Lowercase_Mapping);
213               Digit := False;
214
215            when 'a' .. 'z' =>
216               Aux.Append (Item.Element (J));
217               Digit := False;
218
219            when '0' .. '9' =>
220               if Item.Element (J) /= '0' or Digit then
221                  Aux.Append (Item.Element (J));
222                  Digit := True;
223               end if;
224
225            when others =>
226               null;
227         end case;
228      end loop;
229
230      return Aux;
231   end Normalize;
232
233   -----------
234   -- Parse --
235   -----------
236
237   procedure Parse (File : League.Strings.Universal_String) is
238      Source : aliased XML.SAX.Input_Sources.Streams.Files.File_Input_Source;
239      Reader : aliased XML.SAX.Simple_Readers.SAX_Simple_Reader;
240      Parser : aliased CSMIB_Parser;
241
242   begin
243      Reader.Set_Content_Handler (Parser'Unchecked_Access);
244      Source.Open_By_File_Name (File);
245      Reader.Parse (Source'Unchecked_Access);
246      Source.Close;
247   end Parse;
248
249   -------------------
250   -- Start_Element --
251   -------------------
252
253   overriding procedure Start_Element
254    (Self           : in out CSMIB_Parser;
255     Namespace_URI  : League.Strings.Universal_String;
256     Local_Name     : League.Strings.Universal_String;
257     Qualified_Name : League.Strings.Universal_String;
258     Attributes     : XML.SAX.Attributes.SAX_Attributes;
259     Success        : in out Boolean) is
260   begin
261      if Qualified_Name = Alias_Element then
262         Self.Text.Clear;
263         Self.Collect := True;
264
265      elsif Qualified_Name = Name_Element then
266         Self.Text.Clear;
267         Self.Collect := True;
268
269      elsif Qualified_Name = Record_Element then
270         Self.Aliases.Clear;
271         Self.MIB := Positive'Last;
272         Self.In_Record := True;
273
274      elsif Qualified_Name = Value_Element then
275         Self.Text.Clear;
276         Self.Collect := True;
277      end if;
278   end Start_Element;
279
280end CSMIB.Parser;
281