|
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: 22271 (0x56ff)
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 Broker_Defs;
with Field_Parser;
with Notice;
with Request;
with Slot;
with Text_Io;
use Broker_Defs;
-- necessary to not redefine Broker_defs.class."="
package body Canvas is
----- creation functions -----
function Create_Request return Object is
A_Request : Object (Broker_Defs.Request);
begin
return A_Request;
end Create_Request;
function Create_Notice return Object is
A_Notice : Object (Broker_Defs.Notice);
begin
return A_Notice;
end Create_Notice;
----- accessing functions -----
function Class_Of (The_Object : in Object) return Broker_Defs.Class is
begin
return The_Object.Class;
end Class_Of;
function Status_Of (The_Object : in Object) return Broker_Defs.Status is
begin
return The_Object.Status;
end Status_Of;
function Result_Of (The_Object : in Object) return Broker_Defs.Result is
begin
return The_Object.Result;
end Result_Of;
function Element_Of (The_Object : in Object) return Request.Element is
begin
return The_Object.Request_Element;
end Element_Of;
function Element_Of (The_Object : in Object) return Notice.Element is
begin
return The_Object.Notice_Element;
end Element_Of;
----- modifing procedures -----
procedure Add_Status (The_Status : in Broker_Defs.Status;
Into_The_Object : in out Object) is
begin
Into_The_Object.Status := The_Status;
end Add_Status;
procedure Add_Result (The_Result : in Broker_Defs.Result;
Into_The_Object : in out Object) is
begin
Into_The_Object.Result := The_Result;
end Add_Result;
procedure Add_Element (The_Element : in Request.Element;
Into_The_Object : in out Object) is
begin
Into_The_Object.Request_Element := The_Element;
end Add_Element;
procedure Add_Element (The_Element : in Notice.Element;
Into_The_Object : in out Object) is
begin
Into_The_Object.Notice_Element := The_Element;
end Add_Element;
----- global functions -----
function Image (The_Object : in Object) return String is
function Request_Image is new Request.Image
(Separator => Umps_Defs.Separator);
function Notice_Image is new Notice.Image
(Separator => Umps_Defs.Separator);
begin
case Class_Of (The_Object) is
when Broker_Defs.Request =>
return Broker_Defs.Class_Image (Class_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Status_Image (Status_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Result_Image (Result_Of (The_Object)) &
Umps_Defs.Separator &
Request_Image (The_Object.Request_Element);
when Broker_Defs.Notice =>
return Broker_Defs.Class_Image (Class_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Status_Image (Status_Of (The_Object)) &
Umps_Defs.Separator &
Broker_Defs.Result_Image (Result_Of (The_Object)) &
Umps_Defs.Separator &
Notice_Image (The_Object.Notice_Element);
end case;
end Image;
function Value (The_String : in String) return Object is
Message_Class_Position : Positive := Positive'First;
Status_Position : Positive := Positive'Succ (Message_Class_Position);
Result_Position : Positive := Positive'Succ (Status_Position);
Sender_Position : Positive := Positive'Succ (Result_Position);
Handler_Position : Positive := Positive'Succ (Sender_Position);
Method_Position : Positive := Positive'Succ (Handler_Position);
Notice_Class_Position : Positive := Positive'Succ (Handler_Position);
Notice_Id_Position : Positive := Positive'Succ (Notice_Class_Position);
Request_Param_Position : Positive := Positive'Succ (Method_Position);
Notice_Param_Position : Positive := Positive'Succ (Notice_Id_Position);
package Message_Parser is new Field_Parser;
An_Object : Object;
Pos : Integer;
The_Value : String (1 .. The_String'Length);
Last : Natural;
Nb_Param : Natural;
The_Variable : String (1 .. 15);
Last_Of_The_Variable : Natural;
The_Kind : String (1 .. 10); -- length of the largest Slot.Kind
Last_Of_The_Kind : Natural;
The_Data : String (1 .. Umps_Defs.String'Last);
Last_Of_The_Data : Natural;
Field_Position : Positive := Message_Class_Position;
begin
Message_Parser.Open (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Value, Last);
if Field_Position = Message_Class_Position then
case Broker_Defs.Class_Value (The_Value (1 .. Last)) is
when Broker_Defs.Request =>
An_Object := Create_Request;
when Broker_Defs.Notice =>
An_Object := Create_Notice;
end case;
end if;
if Field_Position = Status_Position then
Add_Status (Broker_Defs.Status_Value (The_Value (1 .. Last)),
An_Object);
end if;
if Field_Position = Result_Position then
Add_Result (Broker_Defs.Result_Value (The_Value (1 .. Last)),
An_Object);
end if;
if Field_Position = Sender_Position then
case Class_Of (An_Object) is
when Broker_Defs.Request =>
Request.Add_Sender (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Request_Element);
when Broker_Defs.Notice =>
Notice.Add_Sender (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Notice_Element);
end case;
end if;
if Field_Position = Handler_Position then
case Class_Of (An_Object) is
when Broker_Defs.Request =>
Request.Add_Handler (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Request_Element);
when Broker_Defs.Notice =>
Notice.Add_Handler (Umps_Defs.Behavior_Number'Value
(The_Value (1 .. Last)),
An_Object.Notice_Element);
end case;
end if;
if Field_Position = Method_Position then
if Class_Of (An_Object) = Broker_Defs.Request then
if Message_Parser.Is_Empty_Field (Last) then
Request.Add_Method ("", An_Object.Request_Element);
else
Request.Add_Method (The_Value (1 .. Last),
An_Object.Request_Element);
end if;
end if;
end if;
if Field_Position = Notice_Class_Position then
if Class_Of (An_Object) = Broker_Defs.Notice then
if Message_Parser.Is_Empty_Field (Last) then
Notice.Add_Class ("", An_Object.Notice_Element);
else
Notice.Add_Class (The_Value (1 .. Last),
An_Object.Notice_Element);
end if;
end if;
end if;
if Field_Position = Notice_Id_Position then
if Class_Of (An_Object) = Broker_Defs.Notice then
if Message_Parser.Is_Empty_Field (Last) then
Notice.Add_Class ("", An_Object.Notice_Element);
else
Notice.Add_Id (The_Value (1 .. Last),
An_Object.Notice_Element);
end if;
end if;
end if;
if Field_Position = Request_Param_Position and
Class_Of (An_Object) = Broker_Defs.Request then
Nb_Param := Natural'Value (The_Value (1 .. Last));
Message_Parser.Next (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Variable,
Last_Of_The_Variable);
Message_Parser.Next (The_String, Pos);
Message_Parser.Value
(The_String, Pos, The_Kind, Last_Of_The_Kind);
Message_Parser.Next (The_String, Pos);
if Message_Parser.Done (The_String, Pos) then
Last_Of_The_Data := 0;
-- Text_Io.Put_Line ("Empty DATA field"); -- DEBUG
else
Message_Parser.Value
(The_String, Pos, The_Data, Last_Of_The_Data);
end if;
Message_Parser.Next (The_String, Pos);
if Message_Parser.Is_Empty_Field (Last_Of_The_Data) then
Request.Add_Param
(Slot.Make (The_Variable (1 .. Last_Of_The_Variable),
Slot.Kind'Value
(The_Kind (1 .. Last_Of_The_Kind))),
An_Object.Request_Element);
else
case Slot.Kind'Value (The_Kind
(1 .. Last_Of_The_Kind)) is
when Slot.Integer =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", Integer'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Integer'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Request_Element);
end if;
when Slot.String =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", The_Data
(1 .. Last_Of_The_Data)),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1 .. Last_Of_The_Data)),
An_Object.Request_Element);
end if;
when Slot.Character =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make ("", The_Data (1)),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1)),
An_Object.Request_Element);
end if;
when Slot.Boolean =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make
("", Boolean'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Boolean'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Request_Element);
end if;
when Slot.Void =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Request.Add_Param
(Slot.Make ("", Slot.Void),
An_Object.Request_Element);
else
Request.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Slot.Void),
An_Object.Request_Element);
end if;
end case;
end if;
end loop;
end if;
if Field_Position = Notice_Param_Position and
Class_Of (An_Object) = Broker_Defs.Notice then
Nb_Param := Natural'Value (The_Value (1 .. Last));
Message_Parser.Next (The_String, Pos);
while not Message_Parser.Done (The_String, Pos) loop
Message_Parser.Value (The_String, Pos, The_Variable,
Last_Of_The_Variable);
Message_Parser.Next (The_String, Pos);
Message_Parser.Value
(The_String, Pos, The_Kind, Last_Of_The_Kind);
Message_Parser.Next (The_String, Pos);
if Message_Parser.Done (The_String, Pos) then
Last_Of_The_Data := 0;
-- Text_Io.Put_Line ("Empty DATA field"); -- DEBUG
else
Message_Parser.Value
(The_String, Pos, The_Data, Last_Of_The_Data);
end if;
Message_Parser.Next (The_String, Pos);
if Message_Parser.Is_Empty_Field (Last_Of_The_Data) then
Notice.Add_Param
(Slot.Make (The_Variable (1 .. Last_Of_The_Variable),
Slot.Kind'Value
(The_Kind (1 .. Last_Of_The_Kind))),
An_Object.Notice_Element);
else
case Slot.Kind'Value (The_Kind
(1 .. Last_Of_The_Kind)) is
when Slot.Integer =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", Integer'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Integer'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Notice_Element);
end if;
when Slot.String =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", The_Data
(1 .. Last_Of_The_Data)),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1 .. Last_Of_The_Data)),
An_Object.Notice_Element);
end if;
when Slot.Character =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param (Slot.Make
("", The_Data (1)),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
The_Data (1)),
An_Object.Notice_Element);
end if;
when Slot.Boolean =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param
(Slot.Make
("", Boolean'Value
(The_Data
(1 ..
Last_Of_The_Data))),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Boolean'Value
(The_Data
(1 .. Last_Of_The_Data))),
An_Object.Notice_Element);
end if;
when Slot.Void =>
if Message_Parser.Is_Empty_Field
(Last_Of_The_Variable) then
Notice.Add_Param (Slot.Make ("", Slot.Void),
An_Object.Notice_Element);
else
Notice.Add_Param
(Slot.Make
(The_Variable
(1 .. Last_Of_The_Variable),
Slot.Void),
An_Object.Notice_Element);
end if;
end case;
end if;
end loop;
end if;
Field_Position := Field_Position + 1;
Message_Parser.Next (The_String, Pos);
end loop;
return An_Object;
end Value;
end Canvas;