cgi-config.adb


------------------------------------------------------------------------------
--
--  package CGI.Config (body)
--
--  Handles various configuration information for CGI programs.
--
------------------------------------------------------------------------------
--  Update information:
--
--  1996.07.08 (Jacob Sparre Andersen)
--    Written. Based on Comics_DB.Config (1996.05.15-16).
--
--  1996.07.14 (Jacob Sparre Andersen)
--    Implemented the functions Force_Language and Get_Forced_Language.
--    Debugging.
--    Exchanged package Debugging with package Debugged.
--
--  (Insert additional update information above this line.)
------------------------------------------------------------------------------

with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Text_IO;

with Debugged;
with In_List;
with Messages;
with Trim_Special_Characters;

package body CGI.Config is

   use Debugged;

   ---------------------------------------------------------------------------
   --  Load configuration file:

   package Local_Messages is new Messages (Config_ID);

   Raw_Config_Text : constant Local_Messages.Message_List :=
     Local_Messages.Load (Config_File_Name);

   ---------------------------------------------------------------------------
   --  function Local_Parse (private):
   --
   --  Translates variable names to the corresponding configuration data.
   --
   --  "Base_File_Name"              -  Derived from the name of the program.
   --  Other variables will be translated to an empty string.

   function Local_Parse (Variable_Name : in String) return String is

      use Ada.Characters.Handling;

   begin --  Local_Parse
      if To_Lower (Variable_Name) = "base_file_name" then
         return Base_File_Name;
      else
         Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error,
                               "CGI.Config.Parse_Config_Elements: Unknown " &
                                 "variable name (" & Variable_Name & ").");
         return "";
      end if;
   end Local_Parse;

   ---------------------------------------------------------------------------
   --  function Config_Text (private):

   function Config_Text is new
     Local_Messages.Message (Parse => Local_Parse);

   ---------------------------------------------------------------------------
   --  function Base_File_Name:
   --
   --  Strips the command name of the extension (if there's a '.' in the
   --  name).

   function Base_File_Name return String is

      use Ada.Command_Line;
      use Ada.Strings;
      use Ada.Strings.Fixed;

   begin --  Base_File_Name
      if Count (Command_Name, ".") > 0 then
         return Command_Name (1 .. Index (Command_Name, ".", Backward) - 1);
      else
         return Command_Name;
      end if;
   end Base_File_Name;

   ---------------------------------------------------------------------------
   --  function Config_File_Name:
   --
   --  Returns a name for configuration file.

   function Config_File_Name return String is

   begin --  Config_File_Name
      return Base_File_Name & ".cfg";
   end Config_File_Name;

   ---------------------------------------------------------------------------
   --  Get:

   function Get (ID : in Config_ID) return String is

      use Ada.Strings;
      use Ada.Strings.Fixed;
      use Ada.Text_IO;

   begin --  Get
      Message_Line ("CGI.Config.Get (" & Config_ID'Image (ID) & "): ...");
      Message_Line ("CGI.Config.Get: Result = """ &
                      Trim_Special_Characters (Config_Text
                                                 (Raw_Config_Text (ID)),
                                               Both) & """.");

      return Trim_Special_Characters (Config_Text (Raw_Config_Text (ID)),
                                      Both);
   exception
      when others =>
         Put_Line (Current_Error,
                   "CGI.Config.Get: Unexpected exception.");
         raise;
   end Get;

   ---------------------------------------------------------------------------
   --  function Parse_Config_Elements:
   --
   --  Translates variable names to the corresponding configuration data.
   --
   --  "Base_URL", "Base_Directory"  -  Extracted from the config file.
   --  "Base_File_Name"              -  Derived from the name of the program.
   --  Other variables will be translated to an empty string.

   function Parse_Config_Elements (Variable_Name : in String) return String is

      Name : constant String :=
        Ada.Characters.Handling.To_Lower (Variable_Name);

   begin --  Parse_Config_Elements
      if Name = "base_url" then
         return Get (Base_URL);
      elsif Name = "base_directory" then
         return Get (Base_Directory);
      else
         return Local_Parse (Name);
      end if;
   end Parse_Config_Elements;

   ---------------------------------------------------------------------------
   --  function No_Parse (private):

--     function No_Parse (Variable_Name

   ---------------------------------------------------------------------------
   --  function Force_Language:
   --
   --  Checks if the program is forced to use a specific language.

   function Force_Language return Boolean is

   begin --  Force_Language
      Message_Line ("CGI.Config.Force_Language.");

      return Get (Forced_Language)'Length = 2;
   end Force_Language;

   ---------------------------------------------------------------------------
   --  function Force_Language:
   --
   --  Checks if the program is forced to use a specific language.

   function Force_Language
     (Accepted_Languages : in CGI.Flags.Language_List_Type)
     return Boolean is

      ------------------------------------------------------------------
      --  function In_Language_List:

      function In_Language_List is new In_List
        (Element_Type => CGI.Flags.Language_Type,
         List_Type    => CGI.Flags.Language_List_Type);

      ------------------------------------------------------------------

      use Ada.Characters.Handling;

      Language : constant String := To_Lower (Get (Forced_Language));

   begin --  Force_Language
      Message_Line ("CGI.Config.Force_Language (Accepted_Languages):");
      Message_Line ("  Number of languages: " &
                      Natural'Image (Accepted_Languages'Length));
      Message_Line ("  Language: '" & Language & "'");

      return Language'Length = 2 and then
             In_Language_List (Item => (1 => Language (Language'First),
                                        2 => Language (Language'First + 1)),
                               List    => Accepted_Languages);
   end Force_Language;

   ---------------------------------------------------------------------------
   --  function Get_Forced_Language:
   --
   --  If the program is forced to use a specific language, then this function
   --  returns the language.
   --
   --  Exceptions:
   --    No_Forced_Language - If Force_Language is False.

   function Get_Forced_Language return CGI.Flags.Language_Type is

      use Ada.Characters.Handling;

      Language : constant String := To_Lower (Get (Forced_Language));

   begin --  Get_Forced_Language
      if Language'Length = 2 then
         return (1 => Language (Language'First),
                 2 => Language (Language'First + 1));
      else
         raise No_Forced_Language;
      end if;
   end Get_Forced_Language;

   ---------------------------------------------------------------------------
   --  function Get_Forced_Language:
   --
   --  If the program is forced to use a specific language, then this function
   --  returns the language.
   --
   --  Exceptions:
   --    No_Forced_Language - If Force_Language is False.

   function Get_Forced_Language
     (Accepted_Languages : in CGI.Flags.Language_List_Type)
     return CGI.Flags.Language_Type is

      ------------------------------------------------------------------
      --  function In_Language_List:

      function In_Language_List is new In_List
        (Element_Type => CGI.Flags.Language_Type,
         List_Type    => CGI.Flags.Language_List_Type);

      ------------------------------------------------------------------

      use Ada.Characters.Handling;

      Language : constant String := To_Lower (Get (Forced_Language));

   begin --  Get_Forced_Language
      if Language'Length = 2 and then
         In_Language_List (Item => (1 => Language (Language'First),
                                    2 => Language (Language'First + 1)),
                           List    => Accepted_Languages) then
         return (1 => Language (Language'First),
                 2 => Language (Language'First + 1));
      else
         raise No_Forced_Language;
      end if;
   end Get_Forced_Language;

   ---------------------------------------------------------------------------

end CGI.Config;

Typeset with Ada_To_HTML (Jacob and Jesper)