DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦8f30cb149⟧ TextFile

    Length: 18937 (0x49f9)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

-------------------------------------------------------------------------------
with Direct_Io;  
with Text_Io;
with Request;
with Notice;


package body Database is

    File_Request_Name : constant String := "requests";
    File_Notice_Name  : constant String := "notices";

    Request_File : Request_Io.File_Type;
    Notice_File  : Notice_Io.File_Type;

    --------------------------------------------------------------------------
    procedure Succ (Count : in out Request_Io.Count) is

    begin
        if (Natural (Count) < Natural (Request_Io.Count'Last)) then
            Count := Request_Io.Count'Succ (Count);  
        end if;
    end Succ;

    --------------------------------------------------------------------------
    procedure Pred (Count : in out Request_Io.Count) is

    begin
        if (Natural (Count) > Natural (Request_Io.Count'First)) then
            Count := Request_Io.Count'Pred (Count);  
        end if;
    end Pred;

    --------------------------------------------------------------------------
    procedure Succ (Count : in out Notice_Io.Count) is

    begin
        if (Natural (Count) < Natural (Notice_Io.Count'Last)) then
            Count := Notice_Io.Count'Succ (Count);  
        end if;
    end Succ;

    --------------------------------------------------------------------------
    procedure Pred (Count : in out Notice_Io.Count) is

    begin
        if (Natural (Count) > Natural (Notice_Io.Count'First)) then
            Count := Notice_Io.Count'Pred (Count);  
        end if;
    end Pred;

    --------------------------------------------------------------------------
    procedure Put (The_Element : Request.Element;
                   Action      : Actions := Performed;
                   Status      : States  := Unlock) is  
        Count  : Request_Io.Count;
        R_Data : Request_Data;

    begin
        R_Data.The_Element := The_Element;
        Request.Add_Handler (Umps_Defs.Any_Behaviors, R_Data.The_Element);
        R_Data.State  := Status;
        R_Data.Action := Action;
        Count         := Request_Io.Size (Request_File);
        Succ (Count);
        Request_Io.Write (Request_File, R_Data, Count);

    exception
        when Request_Io.Use_Error =>
            raise Too_Many_Requests_Error;
        when Request_Io.Mode_Error =>
            raise Internal_Error;
        when Request_Io.Device_Error =>
            raise Device_Error;
    end Put;

    --------------------------------------------------------------------------
    procedure Put (The_Element : Notice.Element) is  
        Count  : Notice_Io.Count;  
        N_Data : Notice_Data;

    begin  
        N_Data.The_Element := The_Element;
        Notice.Add_Handler (Umps_Defs.Any_Behaviors, N_Data.The_Element);
        Count := Notice_Io.Size (Notice_File);  
        Succ (Count);
        Notice_Io.Write (Notice_File, N_Data, Count);

    exception
        when Notice_Io.Use_Error =>
            raise Too_Many_Requests_Error;
        when Notice_Io.Mode_Error =>
            raise Internal_Error;
        when Notice_Io.Device_Error =>
            raise Device_Error;
    end Put;

    --------------------------------------------------------------------------
    procedure Next (Iter : in out Iter_Request) is
        Element : Request.Element;
        R_Data  : Request_Data;  
        function Is_Field_Equal is new Request.Is_Equal (Field => Iter.Field);

    begin
        Succ (Iter.Count);
        Request_Io.Set_Index (Request_File, Iter.Count);

        Search_Next_Element:
            while (not Request_Io.End_Of_File (Request_File)) loop  
                Request_Io.Read (Request_File, R_Data);

                if ((Iter.State = States'(Both) or else
                     R_Data.State = Iter.State) and then
                    (Iter.Action = Actions'(Both) or else
                     R_Data.Action = Iter.Action)) then

                    Element := Iter.Condition_Data;  
                    if (Request.Sender (Element) = Umps_Defs.Any_Behaviors) then
                        Request.Add_Sender
                           (Request.Sender (R_Data.The_Element), Element);
                    end if;

                    exit Search_Next_Element when
                       Is_Field_Equal (R_Data.The_Element, Element);

                end if;

                Succ (Iter.Count);
            end loop Search_Next_Element;

    exception
        when Notice_Io.End_Error =>
            raise Internal_Error;
        when Notice_Io.Data_Error =>
            raise Integrity_Error;
        when Notice_Io.Mode_Error =>
            raise Internal_Error;
        when Notice_Io.Device_Error =>
            raise Device_Error;
    end Next;

    --------------------------------------------------------------------------
    procedure Next (Iter : in out Iter_Notice) is  
        Element : Notice.Element;
        N_Data  : Notice_Data;  
        function Is_Field_Equal is new Notice.Is_Equal (Field => Iter.Field);

    begin
        Succ (Iter.Count);
        Notice_Io.Set_Index (Notice_File, Iter.Count);

        Search_Next_Element:
            while (not Notice_Io.End_Of_File (Notice_File)) loop  
                Notice_Io.Read (Notice_File, N_Data);

                Element := Iter.Condition_Data;  
                if (Notice.Sender (Element) = Umps_Defs.Any_Behaviors) then
                    Notice.Add_Sender
                       (Notice.Sender (N_Data.The_Element), Element);
                end if; -- They must have the same behavior number

                exit Search_Next_Element when Is_Field_Equal
                                                 (N_Data.The_Element, Element);

                Succ (Iter.Count);
            end loop Search_Next_Element;

    exception
        when Notice_Io.End_Error =>
            raise Internal_Error;
        when Notice_Io.Data_Error =>
            raise Integrity_Error;
        when Notice_Io.Mode_Error =>
            raise Internal_Error;
        when Notice_Io.Device_Error =>
            raise Device_Error;
    end Next;

    --------------------------------------------------------------------------
    procedure Init (Iter     : in out Iter_Request;
                    On       :        Request.Element;
                    Field    :        Slot.Fields := Slot.On_Value;
                    Action   :        Actions := Interested;
                    State    :        States := Unlock;
                    Behavior :        Umps_Defs.Behavior_Number :=
                       Umps_Defs.Any_Behaviors) is

    begin  
        Iter.Condition_Data := On;
        Request.Add_Sender (Behavior, Into => Iter.Condition_Data);
        Request.Add_Handler (Umps_Defs.Any_Behaviors,
                             Into => Iter.Condition_Data);
        Iter.Count  := Request_Io.Count'First;
        Iter.Field  := Field;
        Iter.State  := State;
        Iter.Action := Action;
        Next (Iter);
    end Init;

    --------------------------------------------------------------------------
    procedure Init (Iter     : in out Iter_Notice;
                    On       :        Notice.Element;
                    Field    :        Slot.Fields := Slot.On_Value;
                    Behavior :        Umps_Defs.Behavior_Number :=
                       Umps_Defs.Any_Behaviors  
                    ) is

    begin
        Iter.Condition_Data := On;
        Notice.Add_Sender (Behavior, Into => Iter.Condition_Data);
        Notice.Add_Handler (Umps_Defs.Any_Behaviors,
                            Into => Iter.Condition_Data);
        Iter.Count := Notice_Io.Count'First;  
        Iter.Field := Field;
        Next (Iter);
    end Init;

    --------------------------------------------------------------------------
    function Done (Iter : Iter_Request) return Boolean is

    begin
        return (Natural (Iter.Count) > Natural
                                          (Request_Io.Size (Request_File)));
    end Done;

    --------------------------------------------------------------------------
    function Done (Iter : Iter_Notice) return Boolean is

    begin
        return (Natural (Iter.Count) > Natural (Notice_Io.Size (Notice_File)));
    end Done;

    --------------------------------------------------------------------------
    procedure Value (Iter        :     Iter_Request;
                     The_Element : out Request.Element;
                     Action      : out Actions;
                     State       : out States) is
        R_Data : Request_Data;

    begin  
        if (not Done (Iter)) then
            Request_Io.Read (Request_File, R_Data, Iter.Count);
            The_Element := R_Data.The_Element;
            Action      := R_Data.Action;
            State       := R_Data.State;
        else
            raise Iterator_Error;
        end if;

    exception  
        when Request_Io.End_Error =>
            raise Internal_Error;
        when Request_Io.Data_Error =>
            raise Integrity_Error;
        when Request_Io.Mode_Error =>
            raise Internal_Error;
        when Request_Io.Device_Error =>
            raise Device_Error;
    end Value;

    --------------------------------------------------------------------------
    procedure Value (Iter : Iter_Notice; The_Element : out Notice.Element) is
        N_Data : Notice_Data;

    begin  
        if (not Done (Iter)) then
            Notice_Io.Read (Notice_File, N_Data, Iter.Count);
            The_Element := N_Data.The_Element;
        else
            raise Iterator_Error;
        end if;

    exception
        when Notice_Io.End_Error =>
            raise Internal_Error;
        when Notice_Io.Data_Error =>
            raise Integrity_Error;
        when Notice_Io.Mode_Error =>
            raise Internal_Error;
        when Notice_Io.Device_Error =>
            raise Device_Error;
    end Value;

    --------------------------------------------------------------------------
    procedure Replace (Iter        : Iter_Request;
                       The_Element : Request.Element;
                       With_Action : Actions := Performed;
                       With_State  : States  := Unlock) is
        R_Data : Request_Data;

    begin  
        R_Data.The_Element := The_Element;
        R_Data.Action      := With_Action;
        R_Data.State       := With_State;
        Request_Io.Write (Request_File, R_Data, Iter.Count);

    exception
        when Request_Io.Use_Error =>
            raise Internal_Error;
            -- It's a rewrite
        when Request_Io.Mode_Error =>
            raise Internal_Error;
        when Request_Io.Device_Error =>
            raise Device_Error;
    end Replace;

    --------------------------------------------------------------------------
    procedure Replace (Iter : Iter_Notice; The_Element : Notice.Element) is
        N_Data : Notice_Data;

    begin  
        N_Data.The_Element := The_Element;
        Notice_Io.Write (File => Notice_File, Item => N_Data, To => Iter.Count);

    exception
        when Notice_Io.Use_Error =>
            raise Internal_Error;
            -- It's a rewrite
        when Notice_Io.Mode_Error =>
            raise Internal_Error;
        when Notice_Io.Device_Error =>
            raise Device_Error;
    end Replace;

    --------------------------------------------------------------------------
    procedure Display (R_Data : Request_Data; String_Before : String := "") is

    begin
        Text_Io.Put_Line (String_Before & "State  => " &
                          States'Image (R_Data.State));
        Text_Io.Put_Line (String_Before & "Action => " &
                          Actions'Image (R_Data.Action));
        Request.Display (R_Data.The_Element, String_Before & "      ");
    end Display;

    --------------------------------------------------------------------------
    procedure Display (N_Data : Notice_Data; String_Before : String := "") is

    begin  
        Notice.Display (N_Data.The_Element, String_Before);
    end Display;

    --------------------------------------------------------------------------
    procedure Display_Requests (String_Before : String := "") is

    begin  
        if (Natural (Request_Io.Size (Request_File)) = 0) then
            Text_Io.Put_Line (String_Before & "<empty>");
            return;
        end if;  
        Display_All:
            declare
                R_Data : Request_Data;
            begin
                Request_Io.Set_Index (Request_File,
                                      Request_Io.Positive_Count'First);
                Read_And_Display_All:
                    while (not Request_Io.End_Of_File (Request_File)) loop
                        Request_Io.Read (Request_File, R_Data);
                        Display (R_Data, String_Before);
                    end loop Read_And_Display_All;

            exception
                when Request_Io.End_Error =>
                    raise Internal_Error;
                when Request_Io.Data_Error =>
                    raise Integrity_Error;
                when Request_Io.Mode_Error =>
                    raise Internal_Error;
                when Request_Io.Device_Error =>
                    raise Device_Error;
            end Display_All;
    end Display_Requests;

    --------------------------------------------------------------------------
    procedure Display_Notices (String_Before : String := "") is

    begin
        if (Natural (Notice_Io.Size (Notice_File)) = 0) then
            Text_Io.Put_Line (String_Before & "<empty>");
            return;
        end if;

        Display_All:
            declare
                Element : Notice_Data;
            begin
                Notice_Io.Set_Index (Notice_File,
                                     Notice_Io.Positive_Count'First);
                Read_And_Display_All:
                    while (not Notice_Io.End_Of_File (Notice_File)) loop
                        Notice_Io.Read (Notice_File, Element);
                        Display (Element, String_Before);
                    end loop Read_And_Display_All;

            exception
                when Notice_Io.End_Error =>
                    raise Internal_Error;
                when Notice_Io.Data_Error =>
                    raise Integrity_Error;
                when Notice_Io.Mode_Error =>
                    raise Internal_Error;
                when Notice_Io.Device_Error =>
                    raise Device_Error;
            end Display_All;

    end Display_Notices;

    --------------------------------------------------------------------------
    procedure Display is

    begin  
        Text_Io.New_Line;
        Text_Io.New_Line;
        Text_Io.Put_Line ("-- Requests :");
        Display_Requests ("       ");
        Text_Io.Put_Line ("-- End Requests");
        Text_Io.New_Line;
        Text_Io.New_Line;
        Text_Io.Put_Line ("-- Notices : ");
        Display_Notices ("        ");  
        Text_Io.Put_Line ("-- End Notices");
    end Display;

    --------------------------------------------------------------------------
    procedure Open_Anyway_Request_File is

    begin
        Request_Io.Open (File => Request_File,
                         Mode => Request_Io.Inout_File,
                         Name => File_Request_Name);
    exception
        when Request_Io.Name_Error =>
            Creating_Files:
                declare
                begin
                    Request_Io.Create (File => Request_File,
                                       Mode => Request_Io.Inout_File,
                                       Name => File_Request_Name);
                exception
                    when Request_Io.Status_Error =>
                        raise Already_Open_Error;
                    when Request_Io.Name_Error | Request_Io.Use_Error =>
                        raise Internal_Error;
                end Creating_Files;
        when Request_Io.Status_Error =>
            raise Already_Open_Error;
        when Request_Io.Use_Error =>
            raise Internal_Error;
    end Open_Anyway_Request_File;

    --------------------------------------------------------------------------
    procedure Open_Anyway_Notice_File is

    begin
        Notice_Io.Open (File => Notice_File,
                        Mode => Notice_Io.Inout_File,
                        Name => File_Notice_Name);

    exception
        when Notice_Io.Name_Error =>
            Creating_Files:
                declare
                begin
                    Notice_Io.Create (File => Notice_File,
                                      Mode => Notice_Io.Inout_File,
                                      Name => File_Notice_Name);
                exception
                    when Notice_Io.Status_Error =>
                        raise Already_Open_Error;
                    when Notice_Io.Name_Error | Notice_Io.Use_Error =>
                        raise Internal_Error;
                end Creating_Files;
        when Notice_Io.Status_Error =>
            raise Already_Open_Error;
        when Notice_Io.Use_Error =>
            raise Internal_Error;

    end Open_Anyway_Notice_File;

    --------------------------------------------------------------------------
    procedure Destroy is

    begin
        Request_Io.Open (File => Request_File,
                         Mode => Request_Io.Inout_File,
                         Name => File_Request_Name);
        Notice_Io.Open (File => Notice_File,
                        Mode => Notice_Io.Inout_File,
                        Name => File_Notice_Name);
        raise Already_Open_Error;

    exception
        when Already_Open_Error | Request_Io.Status_Error =>
            Deleting_Files:
                declare
                begin
                    Request_Io.Delete (Request_File);
                    Notice_Io.Delete (Notice_File);
                exception
                    when Request_Io.Status_Error =>
                        null;
                    when Request_Io.Use_Error =>
                        raise Internal_Error;
                end Deleting_Files;
        when Request_Io.Device_Error =>
            raise Device_Error;
        when Request_Io.Name_Error | Request_Io.Use_Error =>
            null;
    end Destroy;

    --------------------------------------------------------------------------
    procedure Open is

    begin
        Open_Anyway_Request_File;
        Open_Anyway_Notice_File;
    end Open;

    --------------------------------------------------------------------------
    procedure Close is

    begin
        Open_Anyway_Request_File;
        Open_Anyway_Notice_File;
        raise Already_Open_Error;

    exception
        when Already_Open_Error =>
            Request_Io.Close (Request_File);
            Notice_Io.Close (Notice_File);
    end Close;

end Database;
------------------------------------------------------------------------------