|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 25297 (0x62d1)
Types: TextFile
Names: »B«
└─⟦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⟧
-------------------------------------------------------------------------------
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;
-------------------------------------------------------------------------------