------------------------------------------------------------------------------ -- -- -- Matreshka Project -- -- -- -- Localization, Internationalization, Globalization for Ada -- -- -- -- Runtime Library Component -- -- -- ------------------------------------------------------------------------------ -- -- -- Copyright © 2011, Vadim Godunko -- -- All rights reserved. -- -- -- -- Redistribution and use in source and binary forms, with or without -- -- modification, are permitted provided that the following conditions -- -- are met: -- -- -- -- * Redistributions of source code must retain the above copyright -- -- notice, this list of conditions and the following disclaimer. -- -- -- -- * Redistributions in binary form must reproduce the above copyright -- -- notice, this list of conditions and the following disclaimer in the -- -- documentation and/or other materials provided with the distribution. -- -- -- -- * Neither the name of the Vadim Godunko, IE nor the names of its -- -- contributors may be used to endorse or promote products derived from -- -- this software without specific prior written permission. -- -- -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- -- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -- -- ------------------------------------------------------------------------------ -- $Revision: 1793 $ $Date: 2011-06-11 11:40:44 +0400 (Сб, 11 июн 2011) $ ------------------------------------------------------------------------------ with Ada.Directories; with Ada.Streams.Stream_IO; with League.Stream_Element_Vectors.Internals; with League.Text_Codecs; with Matreshka.Internals.Stream_Element_Vectors; with Matreshka.Internals.Unicode.Characters.Latin; package body Matreshka.Internals.Settings.Ini_Files is use Ada.Streams; use League.Stream_Element_Vectors; use League.Strings; use Matreshka.Internals.Unicode; use Matreshka.Internals.Unicode.Characters.Latin; package Section_Maps is new Ada.Containers.Hashed_Maps (League.Strings.Universal_String, Maps.Map, League.Strings.Hash, League.Strings."=", Maps."="); -- This map is used to group key/value pairs in sections for serialization. Line_Delimiter : constant Stream_Element_Array := (0 => Line_Feed); -- Line_Delimiter : constant Stream_Element_Array -- := (0 => Carriage_Return, 1 => Line_Feed); -- Operating system dependent delimiter of lines in the text file. function To_Locale_String (Item : League.Strings.Universal_String) return String; -- Converts Universal_String to locale 8-bit string to use as file name for -- standard Ada library subprograms. procedure Load (Self : in out Ini_File_Settings'Class); -- Loads data from the file. procedure Parse (Self : in out Ini_File_Settings'Class; Data : League.Stream_Element_Vectors.Stream_Element_Vector); -- Parses data. function Serialize (Self : Ini_File_Settings) return League.Stream_Element_Vectors.Stream_Element_Vector; -- Serializes data. function Decode_Key (Data : Ada.Streams.Stream_Element_Array) return League.Strings.Universal_String; -- Decodes key representation in the file into Universal_String. function Decode_Value (Data : Ada.Streams.Stream_Element_Array) return League.Strings.Universal_String renames Decode_Key; -- Decodes value representation in the file into Universal_String. function Encode_Key (Key : League.Strings.Universal_String) return League.Stream_Element_Vectors.Stream_Element_Vector; -- Encodes key to representation in the file. function Encode_Value (Key : League.Strings.Universal_String) return League.Stream_Element_Vectors.Stream_Element_Vector renames Encode_Key; -- Encodes value to representation in the file. function From_Hex (Image : Ada.Streams.Stream_Element_Array) return Matreshka.Internals.Unicode.Code_Unit_32; -- Constructs Unicode code point from hexadecimal image. Returns -- Code_Unit_32'Last when conversion failed. -------------- -- Contains -- -------------- overriding function Contains (Self : Ini_File_Settings; Key : League.Strings.Universal_String) return Boolean is begin return Self.Values.Contains (Key); end Contains; ------------ -- Create -- ------------ function Create (Manager : not null access Abstract_Manager'Class; File_Name : League.Strings.Universal_String) return not null Settings_Access is begin return Aux : constant not null Settings_Access := new Ini_File_Settings' (Counter => <>, Manager => Manager, File_Name => File_Name, Modified => False, Values => Maps.Empty_Map) do declare Self : Ini_File_Settings'Class renames Ini_File_Settings'Class (Aux.all); begin Self.Load; end; end return; end Create; ---------------- -- Decode_Key -- ---------------- function Decode_Key (Data : Ada.Streams.Stream_Element_Array) return League.Strings.Universal_String is Key : League.Strings.Universal_String; Index : Stream_Element_Offset := Data'First; Code : Code_Unit_32; begin while Index <= Data'Last loop Code := Code_Unit_32'Last; if Data (Index) = Percent_Sign then if Data (Index + 1) = Latin_Capital_Letter_U then -- Unicode long format. if Index + 7 <= Data'Last then Code := From_Hex (Data (Index + 2 .. Index + 7)); end if; Index := Index + 8; elsif Data (Index + 1) = Latin_Small_Letter_U then -- Unicode short format. if Index + 5 <= Data'Last then Code := From_Hex (Data (Index + 2 .. Index + 5)); end if; Index := Index + 6; else -- Two digits format. if Index + 2 <= Data'Last then Code := From_Hex (Data (Index + 1 .. Index + 2)); end if; Index := Index + 3; end if; else Code := Code_Unit_32 (Data (Index)); Index := Index + 1; end if; if Is_Valid (Code) then Key.Append (Wide_Wide_Character'Val (Code)); end if; end loop; return Key; end Decode_Key; ---------------- -- Encode_Key -- ---------------- function Encode_Key (Key : League.Strings.Universal_String) return League.Stream_Element_Vectors.Stream_Element_Vector is Aux : Stream_Element_Vector; Code : Code_Point; To_Hex : constant array (Code_Unit_32 range 0 .. 15) of Stream_Element := (Digit_Zero, Digit_One, Digit_Two, Digit_Three, Digit_Four, Digit_Five, Digit_Six, Digit_Seven, Digit_Eight, Digit_Nine, Latin_Capital_Letter_A, Latin_Capital_Letter_B, Latin_Capital_Letter_C, Latin_Capital_Letter_D, Latin_Capital_Letter_E, Latin_Capital_Letter_F); begin for J in 1 .. Key.Length loop Code := Wide_Wide_Character'Pos (Key.Element (J).To_Wide_Wide_Character); if Code in Space .. Tilde then Aux.Append (Stream_Element (Code)); elsif Code <= 16#FF# then -- Two digits format. Aux.Append (Percent_Sign); Aux.Append (To_Hex ((Code / 16) mod 16)); Aux.Append (To_Hex (Code mod 16)); elsif Code <= 16#FFFF# then -- Short Unicode form. Aux.Append (Percent_Sign); Aux.Append (Latin_Small_Letter_U); Aux.Append (To_Hex ((Code / 4096) mod 16)); Aux.Append (To_Hex ((Code / 256) mod 16)); Aux.Append (To_Hex ((Code / 16) mod 16)); Aux.Append (To_Hex (Code mod 16)); else -- Long Unicode form. Aux.Append (Percent_Sign); Aux.Append (Latin_Capital_Letter_U); Aux.Append (To_Hex ((Code / 1048576) mod 16)); Aux.Append (To_Hex ((Code / 65536) mod 16)); Aux.Append (To_Hex ((Code / 4096) mod 16)); Aux.Append (To_Hex ((Code / 256) mod 16)); Aux.Append (To_Hex ((Code / 16) mod 16)); Aux.Append (To_Hex (Code mod 16)); end if; end loop; return Aux; end Encode_Key; -------------- -- Finalize -- -------------- overriding procedure Finalize (Self : not null access Ini_File_Settings) is begin Self.Sync; end Finalize; -------------- -- From_Hex -- -------------- function From_Hex (Image : Ada.Streams.Stream_Element_Array) return Matreshka.Internals.Unicode.Code_Unit_32 is Code : Code_Unit_32 := 0; Index : Stream_Element_Offset := Image'First; begin while Index <= Image'Last loop Code := Code * 16; if Image (Index) in Digit_Zero .. Digit_Nine then Code := Code + Code_Unit_32 (Image (Index)) - Digit_Zero; elsif Image (Index) in Latin_Capital_Letter_A .. Latin_Capital_Letter_F then Code := Code + Code_Unit_32 (Image (Index)) - Latin_Capital_Letter_A + 10; elsif Image (Index) in Latin_Small_Letter_A .. Latin_Small_Letter_F then Code := Code + Code_Unit_32 (Image (Index)) - Latin_Small_Letter_A + 10; else return Code_Unit_32'Last; end if; if Code not in Code_Point then return Code_Unit_32'Last; end if; Index := Index + 1; end loop; return Code; end From_Hex; ---------- -- Load -- ---------- procedure Load (Self : in out Ini_File_Settings'Class) is use Ada.Streams.Stream_IO; File : File_Type; Buffer : Stream_Element_Array (1 .. 1024); Data : Stream_Element_Vector; Last : Stream_Element_Offset; begin if Ada.Directories.Exists (To_Locale_String (Self.File_Name)) then -- Load content of the file. Open (File, In_File, To_Locale_String (Self.File_Name)); loop Read (File, Buffer, Last); exit when Last < Buffer'First; Data.Append (Buffer (Buffer'First .. Last)); end loop; Close (File); -- Parse. Self.Parse (Data); end if; end Load; ---------- -- Name -- ---------- overriding function Name (Self : not null access Ini_File_Settings) return League.Strings.Universal_String is begin return Self.File_Name; end Name; ----------- -- Parse -- ----------- procedure Parse (Self : in out Ini_File_Settings'Class; Data : League.Stream_Element_Vectors.Stream_Element_Vector) is use Matreshka.Internals.Stream_Element_Vectors; procedure Parse_Line; -- Determine boundary of the next line. Buffer : constant Shared_Stream_Element_Vector_Access := League.Stream_Element_Vectors.Internals.Internal (Data); Line_First : Stream_Element_Offset; Line_Last : Stream_Element_Offset; Equal_Index : Stream_Element_Offset; Key_Last : Stream_Element_Offset; Value_First : Stream_Element_Offset; Current_Section : Universal_String; Key : Universal_String; ---------------- -- Parse_Line -- ---------------- procedure Parse_Line is begin Line_First := Line_Last + 1; -- Skip leading whitespaces. while Line_First < Buffer.Length loop exit when Buffer.Value (Line_First) /= Space and Buffer.Value (Line_First) /= Character_Tabulation and Buffer.Value (Line_First) /= Carriage_Return and Buffer.Value (Line_First) /= Line_Feed; Line_First := Line_First + 1; end loop; Line_Last := Line_First; Equal_Index := Line_First - 1; -- Scan line. while Line_Last < Buffer.Length loop -- Exit when end of line is reached. exit when Buffer.Value (Line_Last) = Carriage_Return or Buffer.Value (Line_Last) = Line_Feed; -- Save position of first occurrence of equal sign. if Buffer.Value (Line_Last) = Equals_Sign and Equal_Index < Line_First then Equal_Index := Line_Last; end if; Line_Last := Line_Last + 1; end loop; Line_Last := Line_Last - 1; -- Remove trailing whitespaces. loop exit when Buffer.Value (Line_Last) /= Character_Tabulation and Buffer.Value (Line_Last) /= Space; Line_Last := Line_Last - 1; end loop; -- Determine key and value boundary. if Equal_Index >= Line_First then Key_Last := Equal_Index - 1; while Key_Last >= Line_First loop exit when Buffer.Value (Key_Last) /= Character_Tabulation and Buffer.Value (Key_Last) /= Space; Key_Last := Key_Last - 1; end loop; Value_First := Equal_Index + 1; while Value_First <= Line_Last loop exit when Buffer.Value (Value_First) /= Character_Tabulation and Buffer.Value (Value_First) /= Space; Value_First := Value_First + 1; end loop; end if; end Parse_Line; begin Line_Last := -1; loop Parse_Line; exit when Line_Last < Line_First; if Buffer.Value (Line_First) = Semicolon then -- This is a comment line. null; elsif Buffer.Value (Line_First) = Left_Square_Bracket then -- Section. Line_First := Line_First + 1; if Buffer.Value (Line_Last) = Right_Square_Bracket then Key_Last := Line_Last - 1; else Key_Last := Line_Last; end if; -- Strip leading whitespaces. while Line_First <= Key_Last loop exit when Buffer.Value (Line_First) /= Character_Tabulation and Buffer.Value (Line_First) /= Space; Line_First := Line_First + 1; end loop; -- Strip trailing whitespaces. while Key_Last >= Line_First loop exit when Buffer.Value (Key_Last) /= Character_Tabulation and Buffer.Value (Key_Last) /= Space; Key_Last := Key_Last - 1; end loop; Current_Section := Decode_Key (Buffer.Value (Line_First .. Key_Last)); elsif Equal_Index >= Line_First then -- Key/value pair. Key := Current_Section; if not Key.Is_Empty then Key.Append ('/'); end if; Key.Append (Decode_Key (Buffer.Value (Line_First .. Key_Last))); if not Self.Values.Contains (Key) then Self.Values.Insert (Key, To_Stream_Element_Vector (Buffer.Value (Value_First .. Line_Last))); end if; else -- Incorrect line. null; end if; end loop; end Parse; ------------ -- Remove -- ------------ overriding procedure Remove (Self : in out Ini_File_Settings; Key : League.Strings.Universal_String) is begin if Self.Values.Contains (Key) then Self.Values.Delete (Key); Self.Modified := True; end if; end Remove; --------------- -- Serialize -- --------------- function Serialize (Self : Ini_File_Settings) return League.Stream_Element_Vectors.Stream_Element_Vector is procedure Group_Pair (Position : Maps.Cursor); -- Add pair into sections map. procedure Serialize_Section (Position : Section_Maps.Cursor); -- Serialize specified section and its key/value pairs. procedure Serialize_Pair (Position : Maps.Cursor); -- Serialize specified key/value pair. Aux : League.Stream_Element_Vectors.Stream_Element_Vector; Sections : Section_Maps.Map; ---------------- -- Group_Pair -- ---------------- procedure Group_Pair (Position : Maps.Cursor) is procedure Insert_Pair (Section_Key : Universal_String; Section_Values : in out Maps.Map); -- Insert current key/value pair into the specified section. It -- removes first component of key name. Key : constant Universal_String := Maps.Key (Position); Value : constant Stream_Element_Vector := Maps.Element (Position); Index : constant Natural := Key.Index ('/'); Section_Position : Section_Maps.Cursor; ----------------- -- Insert_Pair -- ----------------- procedure Insert_Pair (Section_Key : Universal_String; Section_Values : in out Maps.Map) is begin if Index = 0 then Section_Values.Insert (Key, Value); else Section_Values.Insert (Key.Slice (Index + 1, Key.Length), Value); end if; end Insert_Pair; begin if Index = 0 then Section_Position := Sections.Find (Empty_Universal_String); if not Section_Maps.Has_Element (Section_Position) then Sections.Insert (Empty_Universal_String, Maps.Empty_Map); Section_Position := Sections.Find (Empty_Universal_String); end if; else Section_Position := Sections.Find (Key.Slice (1, Index - 1)); if not Section_Maps.Has_Element (Section_Position) then Sections.Insert (Key.Slice (1, Index - 1), Maps.Empty_Map); Section_Position := Sections.Find (Key.Slice (1, Index - 1)); end if; end if; Sections.Update_Element (Section_Position, Insert_Pair'Access); end Group_Pair; -------------------- -- Serialize_Pair -- -------------------- procedure Serialize_Pair (Position : Maps.Cursor) is Key : constant Universal_String := Maps.Key (Position); Value : constant Stream_Element_Vector := Maps.Element (Position); begin Aux.Append (Encode_Key (Key)); Aux.Append (Equals_Sign); Aux.Append (Value); Aux.Append (Line_Delimiter); end Serialize_Pair; ----------------------- -- Serialize_Section -- ----------------------- procedure Serialize_Section (Position : Section_Maps.Cursor) is Section : constant Universal_String := Section_Maps.Key (Position); Values : constant Maps.Map := Section_Maps.Element (Position); begin Aux.Append (Left_Square_Bracket); Aux.Append (Encode_Key (Section)); Aux.Append (Right_Square_Bracket); Aux.Append (Line_Delimiter); Values.Iterate (Serialize_Pair'Access); Aux.Append (Line_Delimiter); end Serialize_Section; begin -- Group key/value pair into sections. Self.Values.Iterate (Group_Pair'Access); -- Serialize sections and their key/value pairs. Sections.Iterate (Serialize_Section'Access); return Aux; end Serialize; --------------- -- Set_Value -- --------------- overriding procedure Set_Value (Self : in out Ini_File_Settings; Key : League.Strings.Universal_String; Value : League.Holders.Holder) is begin Self.Modified := True; Self.Values.Include (Key, Encode_Value (League.Holders.Element (Value))); end Set_Value; ---------- -- Sync -- ---------- overriding procedure Sync (Self : in out Ini_File_Settings) is use Ada.Streams.Stream_IO; use League.Stream_Element_Vectors.Internals; Name : constant String := To_Locale_String (Self.File_Name); File : File_Type; Data : Stream_Element_Vector; begin if Self.Modified then -- Serialize data. Data := Serialize (Self); -- Creates directory when necessary. Ada.Directories.Create_Path (Ada.Directories.Containing_Directory (Name)); -- Writes data into file. Create (File, Out_File, Name); Write (File, Internal (Data).Value (0 .. Internal (Data).Length - 1)); Close (File); Self.Modified := False; end if; end Sync; ---------------------- -- To_Locale_String -- ---------------------- function To_Locale_String (Item : League.Strings.Universal_String) return String is Aux : constant Stream_Element_Array := League.Text_Codecs.Codec_For_Application_Locale.Encode (Item).To_Stream_Element_Array; Str : String (1 .. Aux'Length); for Str'Address use Aux'Address; pragma Import (Ada, Str); begin return Str; end To_Locale_String; ----------- -- Value -- ----------- overriding function Value (Self : Ini_File_Settings; Key : League.Strings.Universal_String) return League.Holders.Holder is begin if Self.Values.Contains (Key) then return League.Holders.To_Holder (Decode_Value (Self.Values.Element (Key).To_Stream_Element_Array)); else return League.Holders.Empty_Holder; end if; end Value; end Matreshka.Internals.Settings.Ini_Files;