-------------------------------------------------------------------------------
--
--  <STRONG>Copyright &copy; 2001, 2002 by Thomas Wolf.</STRONG>
--  <BLOCKQUOTE>
--    This piece of software is free software; you can redistribute it and/or
--    modify it under the terms of the  GNU General Public License as published
--    by the Free Software  Foundation; either version 2, or (at your option)
--    any later version. This software is distributed in the hope that it will
--    be useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
--  </BLOCKQUOTE>
--  <BLOCKQUOTE>
--    As a special exception from the GPL, if other files instantiate generics
--    from this unit, or you link this unit with other files to produce an
--    executable, this unit does not by itself cause the resulting executable
--    to be covered by the GPL. This exception does not however invalidate any
--    other reasons why the executable file might be covered by the GPL.
--  </BLOCKQUOTE>
--
--  <AUTHOR>
--    Thomas Wolf  (TW) <E_MAIL>
--  </AUTHOR>
--
--  <PURPOSE>
--    Simple configuration reader/writer. A configuration file consists of
--    lines of the format key [= value].
--
--    The file format allows for line comments (starting with '#' and
--    extending up to the end of the line) and line continuations using
--    the backslash notation.
--  </PURPOSE>
--
--  <NOT_TASK_SAFE>
--
--  <STORAGE>
--    Dynamic storage allocation in the default pool. @Configuration@s are
--    controlled types.
--  </STORAGE>
--
--  <HISTORY>
--    19-JUN-2002   TW  Initial version.
--    08-JUN-2003   TW  Added 'Full_Name' to 'Set_File_Name'. Uses the full
--                      name now in the recursion stack in 'Read'.
--  </HISTORY>
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Exceptions;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with Util.Files.Text_IO;
with Util.Strings;

package body Util.Files.Config is

   use Util.Strings;

   procedure Free is new
     Ada.Unchecked_Deallocation (String, String_Ptr);

   procedure Free is new
     Ada.Unchecked_Deallocation (Files, Stack_Ptr);

   procedure Set_File_Name
     (Self      : in out Reader;
      Name      : in     String;
      Full_Name : in     String)
   is
      pragma Warnings (Off, Self);      --  silence -gnatwa
      pragma Warnings (Off, Name);      --  silence -gnatwa
      pragma Warnings (Off, Full_Name); --  silence -gnatwa
   begin
      null;
   end Set_File_Name;

   function Parse_Key
     (Self : in Reader;
      Line : in String)
     return Natural
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

      I : Natural := Identifier (Line);
      J : Natural;
   begin
      J := I;
      if I /= 0 then
         I := I + 1;
         while I <= Line'Last and then Line (I) = '.' loop
            I := Identifier (Line (I + 1 .. Line'Last));
            exit when I = 0;
            J := I; I := I + 1;
         end loop;
      end if;
      return J;
   end Parse_Key;

   procedure Parse_Operator
     (Self     : in     Reader;
      Line     : in     String;
      From, To :    out Natural)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      From := Line'First;
      while From <= Line'Last and then Is_Blank (Line (From)) loop
         From := From + 1;
      end loop;
      if From <= Line'Last and then Line (From) = '=' then
         To := From;
      else
         To := 0;
      end if;
   end Parse_Operator;

   function Delimiters
     (Self : in Reader)
     return Ada.Strings.Maps.Character_Set
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      return Util.Strings.String_Quotes;
   end Delimiters;

   function Skip_String
     (Self  : in Reader;
      Line  : in String;
      Delim : in Character)
     return Natural
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      return Util.Strings.Skip_String (Line, Delim, Delim);
   end Skip_String;

   procedure Finalize
     (Self : in out Reader)
   is
   begin
      if Self.Stack /= null then
         for I in Self.Stack'Range loop
            Free (Self.Stack (I));
         end loop;
         Free (Self.Stack);
      end if;
   end Finalize;

   procedure Read
     (File_Name : in     String;
      R         : in out Reader'Class)
   is
      Config_Error : exception;

      procedure Push
        (Stack : in out Stack_Ptr;
         File  : access Ada.Text_IO.File_Type;
         Name  : in     String)
      is
      begin
         begin
            Ada.Text_IO.Open (File.all, Ada.Text_IO.In_File, Name);
         exception
            when others =>
               Ada.Exceptions.Raise_Exception
                 (Invalid_Configuration'Identity,
                  "cannot read file '" & Name & ''');
         end;
         --  *Now* check the stack! (And use the full name of the file.)
         declare
            Full_Name : constant String := Ada.Text_IO.Name (File.all);
         begin
            if Stack /= null then
               for J in Stack'Range loop
                  if Stack (J).all = Name then
                     Ada.Text_IO.Close  (File.all);
                     Ada.Exceptions.Raise_Exception
                       (Invalid_Configuration'Identity,
                        "recursive configuration (file '" & Full_Name & ''');
                  end if;
               end loop;
               declare
                  P : constant Stack_Ptr := new Files (1 .. Stack'Last + 1);
               begin
                  P (1 .. Stack'Last) := Stack.all;
                  P (P'Last)          := new String'(Full_Name);
                  Free (Stack);
                  Stack := P;
               end;
            else
               Stack := new Files'(1 => new String'(Full_Name));
            end if;
         end;
      end Push;

      procedure Pop
        (Stack : in out Stack_Ptr)
      is
      begin
         if Stack = null then return; end if;
         declare
            P : constant Stack_Ptr := new Files (1 .. Stack'Last - 1);
         begin
            P.all := Stack (Stack'First .. Stack'Last - 1);
            Free (Stack (Stack'Last)); Free (Stack);
            Stack := P;
         end;
      end Pop;

      function Skip_String
        (Line  : in String;
         Delim : in Character)
        return Natural
      is
      begin
         return Skip_String (R, Line, Delim);
      end Skip_String;

      function Get_Line is
         new Util.Files.Text_IO.Next_Line
               (Delimiters => Delimiters (R), Strings => Skip_String);

      use Ada.Text_IO;

      File   : aliased File_Type;
      Pushed : Boolean := False;

   begin --  Read
      if File_Name'Last < File_Name'First then
         Ada.Exceptions.Raise_Exception
           (Invalid_Configuration'Identity,
            "configuration file name must not be empty");
      end if;
      Push (R.Stack, File'Access, File_Name);
      Pushed := True;
      Set_File_Name (R, File_Name, R.Stack (R.Stack'Last).all);
      while not End_Of_File (File) loop
         declare
            Line : constant String := Trim (Get_Line (File));

            Key_End, Op_Start, Op_End : Natural;
         begin
            exit when Line'Last < Line'First;
            --  Extract Key and Value:
            Key_End := Parse_Key (R, Line);
            if Key_End = 0 then
               Ada.Exceptions.Raise_Exception
                 (Config_Error'Identity, "invalid key");
            else
               --  Yes, we have found a key. 'Key_End' is on its end.
               Parse_Operator
                 (R, Line (Key_End + 1 .. Line'Last), Op_Start, Op_End);
               if Op_End = 0 and then Op_Start <= Line'Last then
                  Ada.Exceptions.Raise_Exception
                    (Config_Error'Identity, "invalid line format");
               end if;
               if Op_End = 0 then
                  New_Key (R, Line (Line'First .. Key_End), "", "");
               else
                  New_Key (R, Line (Line'First .. Key_End),
                           Line (Op_Start .. Op_End),
                           Trim (Line (Op_End + 1 .. Line'Last)));
               end if;
            end if;
         exception
            when Invalid_Configuration =>
               raise;
            when E : others =>
               --  Add filename and line.
               Ada.Exceptions.Raise_Exception
                 (Invalid_Configuration'Identity,
                  "in file '" & File_Name & "': " &
                  Ada.Exceptions.Exception_Message (E) &
                  "; line: " & Line);
         end;
      end loop;
      Close (File); Pop (R.Stack);
   exception
      when others =>
         if Pushed         then Pop (R.Stack); end if;
         if Is_Open (File) then Close (File);  end if;
         raise;
   end Read;

end Util.Files.Config;
