with Text_Io, Singly_Linked_List;
use Text_Io;

package body Database_Interface is

    -- Declarations for the database file
    Test_Name_Xref_File_Name : constant String := "NAMEX.DAT";
    Test_Name_Xref : File_Type;

    -- Declarations for the contents of the database
    Blank_Description : constant Description_Type := (others => ' ');
    type Test_Information is
        record
            Name : Name_Type;
            Architecture_Category : Architecture_Category_Type := Every;
            Version : Version_Type := Other;
            Statistics : Statistics_Type := Both;
            Description : Description_Type := Blank_Description;
            E_And_V_Criteria : E_And_V_Criteria_List;  -- null list
            Language_Features : Language_Features_List; -- null list
        end record;

    -- This list will hold the contents of the database

    package Data_List is new Singly_Linked_List (Test_Information);
    use Data_List;
    type Data_List_Type is new Data_List.List_Type;
    Database_Info : Data_List_Type;

    ---------------------------------------------------------------------------
    -- Internal (Hidden) functions
    package Abbrev_Io is new Enumeration_Io
                                (Schema.Language_Feature_Abbreviation_Type);
    package E_And_V_Io is new Enumeration_Io
                                 (Schema.E_And_V_Criterion_Abbreviation_Type);
    use Abbrev_Io, E_And_V_Io;
    --------------------------------------------------------------------
    -- these functions manipulate lists for the cases where input extends
    -- over more than one line
    --------------------------------------------------------------------
    function E_Copy (List : E_And_V_Criteria_List)
                    return E_And_V_Criteria_List is separate;
    function Copy (List : Language_Features_List)
                  return Language_Features_List is separate;
    function E_Concat (L1, L2 : E_And_V_Criteria_List)
                      return E_And_V_Criteria_List is separate;
    function Concat (L1, L2 : Language_Features_List)
                    return Language_Features_List is separate;
    --
    -- this function gets the next database record from the database file

    function Get_Record (File : File_Type) return Test_Information is separate;


    -- this procedure searches the database, given the NAME as a key
    -- It finds the first entry after the "current pointer" in the list.
    -- Elements of the list must have a .NAME component

    procedure Find_Record (Key : Name_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
    begin
        -- assumes "current pointer" of LIST is set (need not be 1st)
        loop
            exit when Current_Element (List).Name = Key;
            Next (List);
        end loop;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
    end Find_Record;

    ---------------------------------------------------------------------------
    -- these functions search the database, given other keys
    -- ** Could be Generic on Key type, with generic in parameter for
    -- **  record component to match.

    procedure Find_Record (Key : Architecture_Category_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
    begin
        -- assumes "current pointer" of LIST is set (need not be 1st)
        if Key /= Every then
            loop
                exit when Current_Element (List).Architecture_Category = Key;
                Next (List);
            end loop;
        end if;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
    end Find_Record;
    --
    procedure Find_Record (Key : E_And_V_Criterion_Abbreviation_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
        Found : Boolean;
        Temp : E_And_V_Criteria_List;
        procedure Member (Sub_List : in out E_And_V_Criteria_List;
                          Key : E_And_V_Criterion_Abbreviation_Type;
                          Flag : out Boolean) is
        begin
            Flag := False;
            First (Sub_List);
            loop
                if Current_Element (Sub_List) = Key then
                    Flag := True;
                    exit;
                end if;
                exit when Tail_Node (Sub_List);
                Next (Sub_List);
            end loop;
        exception
            when Criterion_Lists.End_Error =>
                Flag := False;
        end Member;
    begin
        loop
            Temp := Current_Element (List).E_And_V_Criteria;
            Member (Temp, Key, Found);
            exit when Found;
            Next (List);
        end loop;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
        when Criterion_Lists.End_Error =>
            Data := Current_Element (List);
    end Find_Record;
    --
    procedure Find_Record (Key : Language_Feature_Abbreviation_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
        Found : Boolean;
        Temp : Language_Features_List;
        procedure Member (Sub_List : in out Language_Features_List;
                          Key : Language_Feature_Abbreviation_Type;
                          Flag : out Boolean) is
        begin
            Flag := False;
            First (Sub_List);
            loop
                if Current_Element (Sub_List) = Key then
                    Flag := True;
                    exit;
                end if;
                exit when Tail_Node (Sub_List);
                Next (Sub_List);
            end loop;
        exception
            when Feature_Lists.End_Error =>
                Flag := False;
        end Member;
    begin
        loop
            Temp := Current_Element (List).Language_Features;
            Member (Temp, Key, Found);
            exit when Found;
            Next (List);
        end loop;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
        when Feature_Lists.End_Error =>
            Data := Current_Element (List);
    end Find_Record;
    --
    procedure Find_Record (Key : Statistics_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
    begin
        if Key /= Both then
            loop
                exit when Current_Element (List).Statistics = Key;
                Next (List);
            end loop;
        end if;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
    end Find_Record;
    --
    procedure Find_Record (Key : Version_Type;
                           List : in out Data_List_Type;
                           Data : out Test_Information) is
    begin
        if Key /= All_Versions then
            loop
                exit when Current_Element (List).Version = Key;
                Next (List);
            end loop;
        end if;
        Data := Current_Element (List);
        Next (List);
    exception
        when Data_List.End_Error =>
            raise Not_Found;
    end Find_Record;

    ---------------------------------------------------------------------------
    -- Exported (visible) functions
    --
    --  These functions support query-by-name
    --
    function Get_Description (Input_Name : Name_Type) return Description_Type is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.Description;
    end Get_Description;
    --
    function Get_Arch_Category (Input_Name : Name_Type)
                               return Architecture_Category_Type is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.Architecture_Category;
    end Get_Arch_Category;
    --
    function Get_E_And_V_Categories
                (Input_Name : Name_Type) return E_And_V_Criteria_List is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.E_And_V_Criteria;
    end Get_E_And_V_Categories;
    --
    function Get_Features (Input_Name : Name_Type)
                          return Language_Features_List is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.Language_Features;
    end Get_Features;
    --
    function Get_Statistics (Input_Name : Name_Type) return Statistics_Type is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.Statistics;
    end Get_Statistics;
    --
    function Get_Version (Input_Name : Name_Type) return Version_Type is
        Temp : Test_Information;
    begin
        First (Database_Info);  -- start at head of database
        Find_Record (Input_Name, Database_Info, Temp);
        return Temp.Version;
    end Get_Version;
    -----------------------------------------------------------------------------
    --  These functions support query-by-attribute
    --
    function Names (Attribute : Architecture_Category_Type) return Name_List is
        List : Name_List;
        Temp : Test_Information;
    begin
        First (List);
        First (Database_Info);  -- start at head of database
        loop
            -- until search fails
            Find_Record (Attribute, Database_Info, Temp);
            Insert_After (List, Temp.Name);
        end loop;
        return List;
    exception
        when Not_Found =>
            return List;
    end Names;
    --
    function Names (Attribute : E_And_V_Criterion_Abbreviation_Type)
                   return Name_List is
        List : Name_List;
        Temp : Test_Information;
    begin
        First (List);
        First (Database_Info);  -- start at head of database
        loop
            -- until search fails
            Find_Record (Attribute, Database_Info, Temp);
            Insert_After (List, Temp.Name);
        end loop;
        return List;
    exception
        when Not_Found =>
            return List;
    end Names;
    --
    function Names (Attribute : Language_Feature_Abbreviation_Type)
                   return Name_List is
        List : Name_List;
        Temp : Test_Information;
    begin
        First (List);
        First (Database_Info);  -- start at head of database
        loop
            -- until search fails
            Find_Record (Attribute, Database_Info, Temp);
            Insert_After (List, Temp.Name);
        end loop;
        return List;
    exception
        when Not_Found =>
            return List;
    end Names;
    --
    function Names (Attribute : Statistics_Type) return Name_List is
        List : Name_List;
        Temp : Test_Information;
    begin
        First (List);
        First (Database_Info);  -- start at head of database
        loop
            -- until search fails
            Find_Record (Attribute, Database_Info, Temp);
            Insert_After (List, Temp.Name);
        end loop;
        return List;
    exception
        when Not_Found =>
            return List;
    end Names;
    --
    function Names (Attribute : Version_Type) return Name_List is
        List : Name_List;
        Temp : Test_Information;
    begin
        First (List);
        First (Database_Info);  -- start at head of database
        loop
            -- until search fails
            Find_Record (Attribute, Database_Info, Temp);
            Insert_After (List, Temp.Name);
        end loop;
        return List;
    exception
        when Not_Found =>
            return List;
    end Names;
    ---------------------------------------------------------------------------

begin
    -- package body

    -- Read the database file just once (it is never altered),
    -- and store it in a list

    Open (Test_Name_Xref, In_File, Test_Name_Xref_File_Name);
    while not End_Of_File (Test_Name_Xref) loop
        Insert_After (Database_Info, Get_Record (Test_Name_Xref));
    end loop;
    Close (Test_Name_Xref);
exception
    when Name_Error =>
        Put ("*** Error: ");
        Put (Test_Name_Xref_File_Name);
        Put_Line (" not found.");
    when Text_Io.End_Error =>
        Close (Test_Name_Xref);
end Database_Interface;
--*************************************************************************