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

⟦35b8c7c3f⟧ TextFile

    Length: 25297 (0x62d1)
    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 Umps_Defs;
with Database;
with Temporary;
with Canvas;
with Broker_Defs;
with Notice;
with Request;  
with Wild_String;
with Slot;  
with Set;

with Text_Io;

package body Broker is

    Character_Message_Max : constant Natural := 4000;

    No_Error                     : constant Broker_Defs.Result := 0;
    Protocol_Error               : constant Broker_Defs.Result := 1000;
    Already_Exist_Error          : constant Broker_Defs.Result := 1001;
    Database_Requests_Full_Error : constant Broker_Defs.Result := 1002;  
    Database_Notices_Full_Error  : constant Broker_Defs.Result := 1003;  
    Database_Device_Error        : constant Broker_Defs.Result := 1004;  
    Database_Internal_Error      : constant Broker_Defs.Result := 1005;
    Cannot_Found_Behavior_Error  : constant Broker_Defs.Result := 1006;

    Query       : constant String := "Query";
    End_Query   : constant String := "End_Query";
    Observation : constant String := "Observation";

    ---------------------------------------------------------------------------
    procedure Put_Notice (The_Full_Notice : Canvas.Object;
                          With_Status     : Broker_Defs.Status;
                          With_Error      : Broker_Defs.Result) is
        Message_Sended : Boolean;  
        A_Full_Notice  : Canvas.Object := The_Full_Notice;

    begin  
        Canvas.Add_Status (With_Status, A_Full_Notice);
        Canvas.Add_Result (With_Error, A_Full_Notice);
        Temporary.Put (Canvas.Image (A_Full_Notice), Message_Sended);
        if (not Message_Sended) then
            null;  
        end if;
    end Put_Notice;

    ---------------------------------------------------------------------------
    procedure Put_Back_Notice (The_Full_Notice : Canvas.Object;
                               With_Status     : Broker_Defs.Status;
                               With_Error      : Broker_Defs.Result) is
        Message_Sended : Boolean;  
        The_Notice     : Notice.Element := Canvas.Element_Of (The_Full_Notice);
        A_Full_Notice  : Canvas.Object  := The_Full_Notice;

    begin  
        Canvas.Add_Status (With_Status, A_Full_Notice);
        Canvas.Add_Result (With_Error, A_Full_Notice);
        Notice.Add_Handler (Notice.Sender (The_Notice), The_Notice);
        Canvas.Add_Element (The_Notice, A_Full_Notice);
        Temporary.Put (Canvas.Image (A_Full_Notice), Message_Sended);
        if (not Message_Sended) then
            null;  
        end if;
    end Put_Back_Notice;

    ---------------------------------------------------------------------------
    procedure Put_Request (The_Full_Request : Canvas.Object;
                           With_Status      : Broker_Defs.Status;
                           With_Error       : Broker_Defs.Result) is
        Message_Sended : Boolean;  
        A_Full_Request : Canvas.Object := The_Full_Request;

    begin  
        Canvas.Add_Status (With_Status, A_Full_Request);
        Canvas.Add_Result (With_Error, A_Full_Request);
        Temporary.Put (Canvas.Image (A_Full_Request), Message_Sended);

        if (not Message_Sended) then
            null;  
        end if;
    end Put_Request;

    ---------------------------------------------------------------------------
    procedure Put_Back_Request (The_Full_Request : Canvas.Object;
                                With_Status      : Broker_Defs.Status;
                                With_Error       : Broker_Defs.Result) is
        Message_Sended : Boolean;
        The_Request : Request.Element := Canvas.Element_Of (The_Full_Request);
        A_Full_Request : Canvas.Object := The_Full_Request;

    begin  
        Canvas.Add_Status (With_Status, A_Full_Request);
        Canvas.Add_Result (With_Error, A_Full_Request);  
        Request.Add_Handler (Request.Sender (The_Request), The_Request);
        Canvas.Add_Element (The_Request, A_Full_Request);
        Temporary.Put (Canvas.Image (A_Full_Request), Message_Sended);

        if (not Message_Sended) then
            null;  
        end if;
    end Put_Back_Request;

    ---------------------------------------------------------------------------
    procedure Record_Request (The_Full_Request : Canvas.Object;  
                              The_Action       : Database.Actions) is
        Finding_Into : Boolean         := False;
        Iter         : Database.Iter_Request;
        The_Request  : Request.Element := Canvas.Element_Of (The_Full_Request);
        A_Request    : Request.Element;  
        Action       : Database.Actions;
        State        : Database.States;

    begin
        Database.Init (Iter,
                       On       => The_Request,
                       Field    => Slot.On_Value,
                       Action   => The_Action,
                       State    => Database.States'(Database.Both),
                       Behavior => Request.Sender (The_Request));
        Search_If_The_Request_Is_Already_Into:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Request, Action, State);
                Finding_Into := True;
                exit Search_If_The_Request_Is_Already_Into;
                Database.Next (Iter); -- Never execute
            end loop Search_If_The_Request_Is_Already_Into;

        if (not Finding_Into) then
            Database.Put (The_Request, The_Action);
            Put_Back_Request (The_Full_Request, Broker_Defs.Done, No_Error);
        else -- Finding_Into
            Put_Back_Request (The_Full_Request, Broker_Defs.Failed,
                              Already_Exist_Error);
        end if;

    exception
        when Database.Too_Many_Requests_Error =>
            Put_Back_Request (The_Full_Request, Broker_Defs.Failed,
                              Database_Requests_Full_Error);
        when Database.Device_Error =>
            Put_Back_Request (The_Full_Request, Broker_Defs.Failed,
                              Database_Device_Error);
        when others =>
            Put_Back_Request (The_Full_Request, Broker_Defs.Failed,
                              Database_Internal_Error);
    end Record_Request;

    ---------------------------------------------------------------------------
    procedure Register_Request (The_Full_Request : Canvas.Object) is

    begin
        if (Wild_String.Is_With_Wildcards
               (Request.Method (Canvas.Element_Of (The_Full_Request)))) then
            Put_Back_Request (The_Full_Request,
                              Broker_Defs.Failed, Protocol_Error);
        else
            Record_Request (The_Full_Request, Database.Performed);
        end if;  
    end Register_Request;

    ---------------------------------------------------------------------------
    procedure Observe_Request (The_Full_Request : Canvas.Object) is

    begin
        Record_Request (The_Full_Request, Database.Interested);
    end Observe_Request;

    ---------------------------------------------------------------------------
    function Put_Into_Full_Notice (The_Request : Request.Element;
                                   With_Handler : Umps_Defs.Behavior_Number;
                                   With_Class : String) return Canvas.Object is
        The_Full_Notice : Canvas.Object := Canvas.Create_Notice;
        A_Notice        : Notice.Element;

    begin
        Notice.Add_Sender (Request.Sender (The_Request), A_Notice);
        Notice.Add_Handler (With_Handler, A_Notice);
        Notice.Add_Class (With_Class, A_Notice);
        Notice.Add_Id (Request.Method (The_Request), A_Notice);
        Notice.Add_Params (Request.Params (The_Request), A_Notice);
        Canvas.Add_Element (A_Notice, The_Full_Notice);
        return The_Full_Notice;
    end Put_Into_Full_Notice;

    ---------------------------------------------------------------------------
    procedure Query_Request (The_Full_Request : Canvas.Object) is
        The_Request : Request.Element := Canvas.Element_Of (The_Full_Request);
        Iter        : Database.Iter_Request;
        A_Request   : Request.Element;
        A_Notice    : Notice.Element;
        Action      : Database.Actions;
        State       : Database.States;
        The_Field   : Slot.Fields     := Slot.On_Value;
    begin
        Put_Back_Request (The_Full_Request, Broker_Defs.Handled, No_Error);

        if (Set.Is_Empty (Request.Params (The_Request))) then
            The_Field := Slot.On_None;
        end if;
        Database.Init (Iter,
                       On     => The_Request,  
                       Field  => The_Field,
                       Action => Database.Performed,
                       State  => Database.States'(Database.Both));
        Search_All_Requests_Corresponding_To_Query:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Request, Action, State);
                Put_Notice (Put_Into_Full_Notice
                               (A_Request,
                                With_Handler => Request.Sender (The_Request),
                                With_Class   => Query),
                            Broker_Defs.Send, No_Error);
                Database.Next (Iter);
            end loop Search_All_Requests_Corresponding_To_Query;

        Put_Notice (Put_Into_Full_Notice
                       (The_Request,
                        With_Handler => Request.Sender (The_Request),
                        With_Class   => End_Query), Broker_Defs.Send, No_Error);

    exception
        when Database.Device_Error =>
            Put_Back_Notice (Put_Into_Full_Notice
                                (The_Request,
                                 With_Handler => Request.Sender (The_Request),
                                 With_Class   => Query),
                             Broker_Defs.Failed, Database_Device_Error);
        when others =>
            Put_Back_Notice (Put_Into_Full_Notice
                                (The_Request,
                                 With_Handler => Request.Sender (The_Request),
                                 With_Class   => Query),
                             Broker_Defs.Failed, Database_Internal_Error);
    end Query_Request;

    ---------------------------------------------------------------------------
    procedure Send_To_All_Interested_Behaviors
                 (The_Full_Request : Canvas.Object) is
        The_Request : Request.Element := Canvas.Element_Of (The_Full_Request);
        A_Request   : Request.Element;
        Iter        : Database.Iter_Request;
        The_Sender  : Umps_Defs.Behavior_Number := Request.Sender (The_Request);
        A_Handler   : Umps_Defs.Behavior_Number;
        The_Handler : Umps_Defs.Behavior_Number :=
           Request.Handler (The_Request);  
        Action      : Database.Actions;
        State       : Database.States;

    begin
        Database.Init (Iter,
                       On     => The_Request,
                       Field  => Slot.On_Value,
                       Action => Database.Interested);

        Search_All_Behaviors_Interested_By:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Request, Action, State);
                A_Handler := Request.Sender (A_Request);
                if (The_Sender /= A_Handler and then
                    The_Handler /= A_Handler) then
                    Put_Notice (Put_Into_Full_Notice
                                   (The_Request,
                                    With_Handler => A_Handler,
                                    With_Class   => Observation),
                                Broker_Defs.Send, No_Error);  
                end if;
                Database.Next (Iter);
            end loop Search_All_Behaviors_Interested_By;
    exception
        when others =>
            null; -- if an error occurs then ignore them

    end Send_To_All_Interested_Behaviors;

    ---------------------------------------------------------------------------
    procedure Complete_Empties_Values (Source      :        Request.Element;
                                       Destination : in out Request.Element) is
        function Is_Value_Equal is
           new Request.Is_Equal (Field => Slot.On_Value);
    begin
        if (not Is_Value_Equal (Source, Destination)) then
            declare
                Iter_Source   : Set.Iterator;
                Iter_Dest     : Set.Iterator;
                Params_Source : Set.Object := Request.Params (Source);
                Params_Dest   : Set.Object := Request.Params (Destination);
                New_Params    : Set.Object := Set.Null_Object;
                Elt_Source    : Slot.Element;
                Elt_Dest      : Slot.Element;

            begin
                Set.Init (Iter_Source, Params_Source);
                Set.Init (Iter_Dest, Params_Dest);
                while (not Set.Done (Iter_Source, Params_Source)) loop
                    Elt_Source := Set.Value (Iter_Source, Params_Source);
                    Elt_Dest   := Set.Value (Iter_Dest, Params_Dest);
                    if (Slot.Is_Empty_Value (Elt_Dest)) then
                        New_Params := Set.Add (Elt_Source, New_Params);
                    else
                        New_Params := Set.Add (Elt_Dest, New_Params);
                    end if;
                    Set.Next (Iter_Source, Params_Source);
                    Set.Next (Iter_Dest, Params_Dest);  
                end loop;
                Request.Add_Params (New_Params, Destination);
            end;
        end if;
    end Complete_Empties_Values;

    ---------------------------------------------------------------------------
    procedure Send_Request_To_Behaviors (The_Full_Request : Canvas.Object) is
        The_Request : Request.Element := Canvas.Element_Of (The_Full_Request);
        A_Request : Request.Element;
        Iter : Database.Iter_Request;
        Finding : Boolean := False;  
        Action : Database.Actions;
        State : Database.States;  
        A_Full_Request : Canvas.Object := The_Full_Request;

    begin
        Database.Init (Iter,
                       On       => The_Request,
                       Field    => Slot.On_Kind,
                       Action   => Database.Performed,
                       State    => Database.Unlock,
                       Behavior => Request.Handler (The_Request));
        Search_The_Request_Corresponding_To_Send:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Request, Action, State);
                Request.Add_Handler (Request.Sender (A_Request), The_Request);
                Canvas.Add_Element (The_Request, A_Full_Request);
                Database.Replace (Iter,
                                  The_Element => A_Request,
                                  With_Action => Database.Performed,
                                  With_State  => Database.Lock);
                Complete_Empties_Values (Source      => A_Request,
                                         Destination => The_Request);
                Canvas.Add_Element (The_Request, A_Full_Request);
                Put_Request (A_Full_Request, Broker_Defs.Send, No_Error);
                Finding := True;
                exit Search_The_Request_Corresponding_To_Send;
                Database.Next (Iter); -- never execute =>
                                      -- searching for only one
            end loop Search_The_Request_Corresponding_To_Send;

        if (not Finding) then
            Put_Back_Request (The_Full_Request, Broker_Defs.Failed,
                              Cannot_Found_Behavior_Error);
        else  
            Send_To_All_Interested_Behaviors (A_Full_Request);
        end if;

    end Send_Request_To_Behaviors;

    ---------------------------------------------------------------------------
    procedure Send_Request (The_Full_Request : Canvas.Object) is

    begin
        if (Wild_String.Is_With_Wildcards
               (Request.Method (Canvas.Element_Of (The_Full_Request)))) then
            Put_Back_Request (The_Full_Request,
                              Broker_Defs.Failed, Protocol_Error);
        else
            Send_Request_To_Behaviors (The_Full_Request);
        end if;

    end Send_Request;

    ---------------------------------------------------------------------------
    procedure Relax_Behavior_And_Propage (The_Full_Request : Canvas.Object) is
        Iter        : Database.Iter_Request;  
        The_Request : Request.Element := Canvas.Element_Of (The_Full_Request);
        A_Request   : Request.Element;  
        Action      : Database.Actions;
        State       : Database.States;

    begin
        Database.Init (Iter,
                       On       => The_Request,
                       Field    => Slot.On_Kind,
                       Action   => Database.Performed,
                       State    => Database.Lock,
                       Behavior => Request.Sender (The_Request));
        Search_The_Request_Corresponding_To_End_Execution:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Request, Action, State);
                Database.Replace (Iter,
                                  The_Element => A_Request,
                                  With_Action => Database.Performed,
                                  With_State  => Database.Unlock);
                Put_Request (The_Full_Request,
                             Canvas.Status_Of (The_Full_Request),
                             Canvas.Result_Of (The_Full_Request));
                exit Search_The_Request_Corresponding_To_End_Execution;
                Database.Next (Iter); -- never execute =>
                                      -- searching for only one
            end loop Search_The_Request_Corresponding_To_End_Execution;

    end Relax_Behavior_And_Propage;

    ---------------------------------------------------------------------------
    procedure Dispatch_Request (The_Full_Request : Canvas.Object) is

    begin
        case (Canvas.Status_Of (The_Full_Request)) is
            when Broker_Defs.Register =>
                Register_Request (The_Full_Request);
            when Broker_Defs.Observed =>
                Observe_Request (The_Full_Request);
            when Broker_Defs.Query =>
                Query_Request (The_Full_Request);
            when Broker_Defs.Send =>
                Send_Request (The_Full_Request);
            when Broker_Defs.Failed =>
                Relax_Behavior_And_Propage (The_Full_Request);  
            when Broker_Defs.Handled =>  
                Relax_Behavior_And_Propage (The_Full_Request);
            when Broker_Defs.Done =>  
                Relax_Behavior_And_Propage (The_Full_Request);
            when others =>
                Put_Back_Request (The_Full_Request,
                                  Broker_Defs.Failed, Protocol_Error);
        end case;
    end Dispatch_Request;

    ---------------------------------------------------------------------------
    procedure Observe_Notice (The_Full_Notice : Canvas.Object) is
        Iter         : Database.Iter_Notice;  
        The_Notice   : Notice.Element := Canvas.Element_Of (The_Full_Notice);
        Finding_Into : Boolean        := False;
        A_Notice     : Notice.Element;

    begin
        Database.Init (Iter,
                       On       => The_Notice,
                       Behavior => Notice.Sender (The_Notice));
        Search_If_The_Notice_Is_Already_Into:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Notice);
                Finding_Into := True;  
                exit Search_If_The_Notice_Is_Already_Into;
                Database.Next (Iter); -- Never execute
            end loop Search_If_The_Notice_Is_Already_Into;

        if (not Finding_Into) then
            Database.Put (The_Notice);  
        end if;

    exception
        when Database.Too_Many_Notices_Error =>
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Failed,
                             Database_Notices_Full_Error);
        when Database.Device_Error =>
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Failed,
                             Database_Device_Error);
        when others =>
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Failed,
                             Database_Internal_Error);
    end Observe_Notice;



    ---------------------------------------------------------------------------
    procedure Send_Notice_To_The_Behaviors (The_Full_Notice : Canvas.Object) is
        Behavior_Interested : Umps_Defs.Behavior_Number;

        The_Notice : Notice.Element := Canvas.Element_Of (The_Full_Notice);
        The_Sender : Umps_Defs.Behavior_Number := Notice.Sender (The_Notice);  
        The_Handler : Umps_Defs.Behavior_Number := Notice.Handler (The_Notice);
        Iter : Database.Iter_Notice;  
        A_Notice : Notice.Element;  
        A_Full_Notice : Canvas.Object := The_Full_Notice;

    begin
        Database.Init (Iter, On => The_Notice);
        Search_All_Behaviors_Interested_By_The_Notice:
            while (not Database.Done (Iter)) loop
                Database.Value (Iter, A_Notice);
                Behavior_Interested := Notice.Sender (A_Notice);
                if (Behavior_Interested /= The_Sender and then
                    Behavior_Interested /= The_Handler) then
                    Notice.Add_Sender (The_Sender, The_Notice);
                    Notice.Add_Handler (Behavior_Interested, The_Notice);
                    Canvas.Add_Element (The_Notice, A_Full_Notice);
                    Put_Notice (A_Full_Notice, Broker_Defs.Send, No_Error);
                end if;
                Database.Next (Iter);
            end loop Search_All_Behaviors_Interested_By_The_Notice;

        if (The_Handler /= Umps_Defs.Any_Behaviors) then
            Notice.Add_Sender (The_Sender, The_Notice);
            Notice.Add_Handler (The_Handler, The_Notice);
            Canvas.Add_Element (The_Notice, A_Full_Notice);
            Put_Notice (A_Full_Notice, Broker_Defs.Send, No_Error);
        end if;

    exception
        when Database.Device_Error =>
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Send,
                             Database_Device_Error);
        when others =>
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Send,
                             Database_Internal_Error);
    end Send_Notice_To_The_Behaviors;

    ---------------------------------------------------------------------------
    procedure Send_Notice (The_Full_Notice : Canvas.Object) is
        The_Notice : Notice.Element := Canvas.Element_Of (The_Full_Notice);

    begin
        if (Wild_String.Is_With_Wildcards (Notice.Class (The_Notice)) or else
            Wild_String.Is_With_Wildcards (Notice.Id (The_Notice))) then
            Put_Back_Notice (The_Full_Notice, Broker_Defs.Failed,
                             Protocol_Error);
        else
            Send_Notice_To_The_Behaviors (The_Full_Notice);
        end if;
    end Send_Notice;

    ---------------------------------------------------------------------------
    procedure Dispatch_Notice (The_Full_Notice : Canvas.Object) is

    begin
        case (Canvas.Status_Of (The_Full_Notice)) is
            when Broker_Defs.Observed =>
                Observe_Notice (The_Full_Notice);
            when Broker_Defs.Send =>
                Send_Notice (The_Full_Notice);
            when others =>
                Put_Back_Notice (The_Full_Notice, Broker_Defs.Failed,
                                 Protocol_Error);
        end case;
    end Dispatch_Notice;

    ---------------------------------------------------------------------------
    procedure Dispatch_Message (The_Message : Canvas.Object) is
        use Broker_Defs;

    begin
        if (Canvas.Class_Of (The_Message) = Broker_Defs.Request) then
            Dispatch_Request (The_Message);
        else
            Dispatch_Notice (The_Message);
        end if;
    end Dispatch_Message;

    ---------------------------------------------------------------------------
    procedure Start is  
        A_Message       : String (1 .. Character_Message_Max);
        Message_Size    : Natural;  
        Message_Receive : Boolean;
        The_Message     : Canvas.Object;

    begin  
        Database.Open;
        Temporary.Init;

        Forever:
            loop  
                Temporary.Get (A_Message, Message_Size, Message_Receive);
                if (Message_Receive) then
                    The_Message := Canvas.Value (A_Message (A_Message'First ..
                                                               Message_Size));
                    Text_Io.Put_Line ("--> Message recu : " &
                                      Canvas.Image (The_Message));
                    Dispatch_Message (The_Message);
                end if;
            end loop Forever;  
    exception
        when Database.Internal_Error =>
            Text_Io.Put_Line ("*** Verify your access rigths");
            raise;
        when others =>
            raise;
    end Start;  
end Broker;
-------------------------------------------------------------------------------