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