src/morzhol-iniparser.adb

   1 ------------------------------------------------------------------------------
   2 --                                 Morzhol                                  --
   3 --                                                                          --
   4 --                         Copyright (C) 2007-2010                          --
   5 --                      Pascal Obry - Olivier Ramonat                       --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.IO_Exceptions;
  23 with Ada.Strings;
  24 with Ada.Strings.Maps;
  25 with Ada.Strings.Unbounded;
  26 with Ada.Text_IO;
  27
  28 package body Morzhol.Iniparser is
  29
  30    use Ada.Text_IO;
  31    use Ada.Strings;
  32    use Ada.Strings.Unbounded;
  33
  34    subtype Line_Length is Positive;
  35
  36    Min_Line_Length : constant Line_Length := 1;
  37    Max_Line_Length : constant Line_Length := 1_024;
  38
  39    subtype Buffer_String is String (Min_Line_Length .. Max_Line_Length);
  40
  41    Parameters : array (Parameter_Name) of Unbounded_String;
  42
  43    package body IO is
  44
  45       package Parameter_IO is
  46          new Ada.Text_IO.Enumeration_IO (Enum => Parameter_Name);
  47       use Parameter_IO;
  48
  49       Config_File : File_Type;
  50
  51       -----------
  52       -- Close --
  53       -----------
  54
  55       procedure Close is
  56       begin
  57          Close (Config_File);
  58       end Close;
  59
  60       ----------
  61       -- Open --
  62       ----------
  63
  64       procedure Open  (Config_File_Name : in String) is
  65
  66          procedure Read_Datas;
  67          --  ??
  68
  69          ----------------
  70          -- Read_Datas --
  71          ----------------
  72
  73          procedure Read_Datas is
  74
  75             procedure Insert_Parameter (From : in String);
  76             --  ??
  77
  78             procedure Check_Completness;
  79             --  ??
  80
  81             Buffer : Buffer_String;
  82             Last   : Natural;
  83             Blanks : constant Maps.Character_Set :=
  84                        Maps.To_Set (" " & ASCII.HT);
  85
  86             -----------------------
  87             -- Check_Completness --
  88             -----------------------
  89
  90             procedure Check_Completness is
  91             begin
  92                for P in Parameter_Name loop
  93                   if Length (Parameters (P)) = 0 then
  94                      raise Uncomplete_Config
  95                        with "Missing value for " & Parameter_Name'Image (P);
  96
  97                   end if;
  98                end loop;
  99             end Check_Completness;
 100
 101             ----------------------
 102             -- Insert_Parameter --
 103             ----------------------
 104
 105             procedure Insert_Parameter (From : in String) is
 106                Last      : Natural;
 107                Parameter : Parameter_Name;
 108             begin
 109                Get (From, Parameter, Last);
 110                Parameters (Parameter) :=
 111                  Trim (To_Unbounded_String (From (Last + 1 .. From'Last)),
 112                        Left  => Blanks,
 113                        Right => Blanks);
 114             exception
 115                when Ada.IO_Exceptions.Data_Error =>
 116                   raise Unknown_Parameter
 117                     with "Wrong parameter '" & From & ''';
 118             end Insert_Parameter;
 119
 120          begin
 121             while not End_Of_File (Config_File) loop
 122                Get_Line (Config_File, Buffer, Last);
 123                if Last /= 0 and then Buffer (Buffer'First) /= '#' then
 124                   Insert_Parameter (Buffer (1 .. Last));
 125                end if;
 126             end loop;
 127             Check_Completness;
 128          end Read_Datas;
 129
 130       begin
 131          Open (Name => Config_File_Name, File => Config_File, Mode => In_File);
 132          Read_Datas;
 133       end Open;
 134
 135       ----------------
 136       -- Save_Close --
 137       ----------------
 138
 139       procedure Save_Close is
 140          Column : constant Positive_Count :=
 141                     Positive_Count (Parameter_Name'Width + 2);
 142       begin
 143          Reset (File => Config_File, Mode => Out_File);
 144
 145          for P in Parameter_Name loop
 146             Put (Config_File, P);
 147             Set_Col (Config_File, Column);
 148             Put (Config_File, To_String (Parameters (P)));
 149             New_Line (Config_File);
 150          end loop;
 151          Close;
 152       end Save_Close;
 153
 154    end IO;
 155
 156    ---------------
 157    -- Get_Value --
 158    ---------------
 159
 160    function Get_Value (Parameter : in Parameter_Name) return String is
 161    begin
 162       return To_String (Parameters (Parameter));
 163    end Get_Value;
 164
 165    function Get_Value (Parameter : in Parameter_Name) return Integer is
 166    begin
 167       return Integer'Value (To_String (Parameters (Parameter)));
 168    end Get_Value;
 169
 170    function Get_Value (Parameter : in Parameter_Name) return Float is
 171    begin
 172       return Float'Value (To_String (Parameters (Parameter)));
 173    end Get_Value;
 174
 175    function Get_Value (Parameter : in Parameter_Name) return Boolean is
 176    begin
 177       return Boolean'Value (To_String (Parameters (Parameter)));
 178    end Get_Value;
 179
 180    ---------------
 181    -- Set_Value --
 182    ---------------
 183
 184    procedure Set_Value (Parameter : in Parameter_Name; Value : in String) is
 185    begin
 186       Parameters (Parameter) :=
 187         Trim (To_Unbounded_String (Value), Side => Both);
 188    end Set_Value;
 189
 190    procedure Set_Value (Parameter : in Parameter_Name; Value : in Integer) is
 191    begin
 192       Set_Value (Parameter, Integer'Image (Value));
 193    end Set_Value;
 194
 195    procedure Set_Value (Parameter : in Parameter_Name; Value : in Float) is
 196    begin
 197       Set_Value (Parameter, Float'Image (Value));
 198    end Set_Value;
 199
 200    procedure Set_Value (Parameter : in Parameter_Name; Value : in Boolean) is
 201    begin
 202       Set_Value (Parameter, Boolean'Image (Value));
 203    end Set_Value;
 204
 205    -----------------
 206    -- Enum_Values --
 207    -----------------
 208
 209    package body Enum_Values is
 210
 211       ---------------
 212       -- Get_Value --
 213       ---------------
 214
 215       function Get_Value (Parameter : in Parameter_Name) return Enum is
 216       begin
 217          return Enum'Value (To_String (Parameters (Parameter)));
 218       end Get_Value;
 219
 220       ---------------
 221       -- Set_Value --
 222       ---------------
 223
 224       procedure Set_Value (Parameter : in Parameter_Name; Value : in Enum) is
 225       begin
 226          Set_Value (Parameter, Enum'Image (Value));
 227       end Set_Value;
 228
 229    end Enum_Values;
 230
 231    -------------------
 232    -- Vector_Values --
 233    -------------------
 234
 235    package body Vector_Values is
 236
 237       ---------------
 238       -- Get_Value --
 239       ---------------
 240
 241       function Get_Value (Parameter : in Parameter_Name) return Vector is
 242
 243          Param : constant String := To_String (Parameters (Parameter));
 244
 245          First : Positive := 1;
 246          Last  : Natural  := 0;
 247
 248          V     : Vector (1 .. Max_Vector_Size);
 249          N     : Positive := V'First;
 250
 251       begin
 252          while Last < Param'Last loop
 253             Get (Param (First .. Param'Last), V (N), Last);
 254             N := N + 1;
 255             First := Last + 1;
 256          end loop;
 257          return V (1 .. N - 1);
 258       end Get_Value;
 259
 260       ---------------
 261       -- Set_Value --
 262       ---------------
 263
 264       procedure Set_Value (Parameter : in Parameter_Name; Value : in Vector) is
 265       begin
 266          Parameters (Parameter) := Null_Unbounded_String;
 267          for I in Value'Range loop
 268             Append (Parameters (Parameter),
 269               Trim (To_Unbounded_String (Image (Value (I))),
 270                 Side => Both) & ' ');
 271          end loop;
 272       end Set_Value;
 273
 274    end Vector_Values;
 275
 276 end Morzhol.Iniparser;