|
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: 15090 (0x3af2)
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 Asa_Definitions;
with Debug_Tools;
with Device_Independent_Io;
with Directory_Tools;
with Io;
with Logger;
with Profile;
with Remote_Operations;
with String_Utilities;
with Unix_Definitions;
pragma Elaborate (Asa_Definitions);
package body Asaopen is
package Asac renames Asa_Definitions.Commands;
package Asas renames Asa_Definitions.Switches;
package Dio renames Device_Independent_Io;
package Dna renames Directory_Tools.Naming;
package Ro renames Remote_Operations;
package Ss renames Simple_Status;
package Su renames String_Utilities;
package Unix renames Unix_Definitions;
Local_Annotations : constant String :=
Asa_Definitions.Main_Class_Directory & ".ANNOTATIONS";
Local_Annotation_Types : constant String :=
Asa_Definitions.Main_Class_Directory & ".ANNOTATION_TYPES";
Template_Error : exception;
function "-" (S1 : in String; S2 : in String) return String is
begin
pragma Assert (S1'Length >= S2'Length and then
S1 (S1'Last - S2'Length + 1 .. S1'Last) = S2);
return S1 (S1'First .. S1'Last - S2'Length);
end "-";
-- ------------------------------
-- ( ) Body of external procedure
-- ------------------------------
procedure Execute (In_Context : in Remote_Operations.Context;
Model : in String;
Template_Name : in String;
State : in out State_Record;
Status : out Simple_Status.Condition) is
-- ----------------
-- ( . ) Local data
-- ----------------
S : Ss.Condition;
Error_File : Io.File_Type; -- The remote stderr and stdout.
Null_Input_File : Dio.File_Type;
Output_File : Io.File_Type; -- The result of executing the script.
Script_File : Io.File_Type;
Template_File : Io.File_Type;
Remote_Annotations : constant String :=
Unix.Temporary_Filename (Asac.Annotations_Extension);
Remote_Annotation_Types : constant String :=
Unix.Temporary_Filename (Asac.Annotation_Types_Extension);
Remote_Output : constant String := Unix.Temporary_Filename ("");
Remote_Processed_Model : constant String :=
Unix.Temporary_Filename (Asac.Model_Extension);
Remote_Script : constant String :=
Unix.Temporary_Filename (Asac.Asaopen_Extension);
--[bugs]
-- Due to a bug in ASA, the .opn extension cannot be included on
-- the command line.
-- Due to a bug in REMOTE_OPERATIONS.EXECUTE, we put a leading
-- space to make sure that the lower bound of the command string
-- is 1.
--
Asaopen_Command : constant String :=
' ' &
Asas.Bin_Directory (Ro.Machine (In_Context)) &
Unix.Context_Separator &
Asac.Asaopen &
' ' &
(Remote_Script - Asac.Asaopen_Extension);
Rm_Command : constant String := Unix.Remove &
' ' &
Remote_Annotations &
' ' &
Remote_Annotation_Types &
' ' &
Remote_Output &
' ' &
Remote_Script &
' ' &
Remote_Processed_Model;
Sed_Command : constant String :=
Unix.Stream_Editor &
' ' &
Unix.Edit &
' ' &
"'/&requirement_[1-9] '""'""'.*'""'""'/s/ /_/g'" &
' ' &
Unix.Edit &
' ' &
"'/&requirement_[1-9] '""'""'[^'""'""']*$/,/'""'""';/s/ /_/g'" &
' ' &
Unix.Edit &
' ' &
"'/&requirement_[1-9]/s/_*\(&requirement_[1-9]\)_*'""'""'/ \1 '""'""'/'" &
' ' &
Unix.Edit &
' ' &
"""s/_*;/;/""" &
' ' &
Model &
' ' &
Unix.Output_Redirect &
' ' &
Remote_Processed_Model;
-- ------------------------
-- ( . ) Template expansion
-- ------------------------
procedure Expand (Template_File : in Io.File_Type;
Script_File : in Io.File_Type) is
use Io;
pragma Assert (Io.Is_Open (Template_File) and then
Io.Mode (Template_File) = Io.In_File and then
Io.Is_Open (Script_File) and then
Io.Mode (Script_File) = Io.Out_File);
--
-- A line is decomposed into symbol fields and constant fields.
-- Fields are separated by the separator. The first field of a
-- line is always a constant field. BOUNDARY is the first
-- character of the current field.
--
type Field is (Constant_Field, Symbol_Field);
Current_Field : Field;
Boundary : Natural;
The_Symbol : Symbol;
begin
while not Io.End_Of_File (Template_File) loop
declare
Line : constant String := Io.Get_Line (Template_File);
begin
Current_Field := Constant_Field;
Boundary := Line'First;
for I in Line'First .. Line'Last - Separator'Length + 1 loop
if Line (I .. I + Separator'Length - 1) = Separator then
case Current_Field is
when Constant_Field =>
--
-- Found the initial symbol separator. First write
-- the text preceding it.
--
Io.Put (Script_File,
Line (Boundary .. I - 1));
Current_Field := Symbol_Field;
Boundary := I + Separator'Length;
when Symbol_Field =>
--
-- Found the final symbol separator. Write the
-- value of the symbol.
--
The_Symbol := Symbol'Value
(Line (Boundary .. I - 1));
case The_Symbol is
when Annotations =>
Io.Put (Script_File,
Remote_Annotations);
when Annotation_Types =>
Io.Put (Script_File,
Remote_Annotation_Types);
when Asaopen.Model =>
Io.Put (Script_File,
Remote_Processed_Model);
when Output =>
Io.Put (Script_File, Remote_Output);
end case;
Current_Field := Constant_Field;
Boundary := I + Separator'Length;
end case;
end if;
end loop;
Io.Put_Line (Script_File, Line (Boundary .. Line'Last));
end;
end loop;
exception
when others =>
raise Template_Error;
end Expand;
begin
--
-- Create a script file to hold the expanded asaopen text. Open
-- the template, expand it, close it. Reset the script file to
-- read mode.
--
Io.Create (File => Script_File,
Mode => Io.Out_File,
Name => "");
Io.Open (File => Template_File,
Mode => Io.In_File,
Name => Template_Name);
Logger.Note ("Expanding template file " & Io.Name (Template_File) &
" into " & Io.Name (Script_File));
Expand (Template_File => Template_File,
Script_File => Script_File);
Io.Close (Template_File);
Io.Reset (File => Script_File,
Mode => Io.In_File);
--
-- Download the script file and close it.
--
Logger.Note ("Copying file " & Io.Name (Script_File) &
" to " & Remote_Script);
Ro.Put (From_File => Io.Convert (Script_File),
To_File => Remote_Script,
In_Context => In_Context,
Status => S);
Logger.Status (S, Interactive => False);
Io.Close (Script_File);
--
-- Download the annotation files.
--
Logger.Note ("Copying file " & Local_Annotations &
" to " & Remote_Annotations);
Ro.Put (From_File => Local_Annotations,
To_File => Remote_Annotations,
In_Context => In_Context,
Status => S);
Logger.Status (S, Interactive => False);
Logger.Note ("Copying file " & Local_Annotation_Types &
" to " & Remote_Annotation_Types);
Ro.Put (From_File => Local_Annotation_Types,
To_File => Remote_Annotation_Types,
In_Context => In_Context,
Status => S);
Logger.Status (S, Interactive => False);
--
-- Create error files.
--
Io.Create (File => Error_File,
Mode => Io.Out_File,
Name => "");
--[bug]
-- Due to a bug in asaopen, the blanks are stripped from the
-- requirements' text. Before calling asaopen, we run sed on the
-- model file to change every space into an underscore. The
-- reverse transformation will be made by package HIERARCHY.
--
Logger.Note ("Executing command """ & Sed_Command & '"');
Ro.Execute (Command => Sed_Command,
In_Context => In_Context,
Input => Null_Input_File,
Output => Io.Convert (Error_File),
Error => Io.Convert (Error_File),
Status => S,
Timeout => Ro.Wait_Forever);
Logger.Status (S, Interactive => False);
--
-- Execute asaopen on the downloaded script file. Do not separate
-- output and error flows.
--
Logger.Note ("Executing command """ & Asaopen_Command & '"');
Ro.Execute (Command => Asaopen_Command,
In_Context => In_Context,
Input => Null_Input_File,
Output => Io.Convert (Error_File),
Error => Io.Convert (Error_File),
Status => S,
Timeout => Ro.Wait_Forever);
--
-- Process the error file.
--
Io.Reset (File => Error_File,
Mode => Io.In_File);
while not Io.End_Of_File (Error_File) loop
Logger.Debug (Io.Get_Line (Error_File));
end loop;
Logger.Status (S, Interactive => False);
--
-- Upload the result of execution.
--
Io.Create (File => Output_File,
Mode => Io.Out_File,
Name => "");
Logger.Note ("Copying file " & Remote_Output &
" to " & Io.Name (Output_File));
Ro.Get (From_File => Remote_Output,
In_Context => In_Context,
To_File => Io.Convert (Output_File),
Status => S);
Logger.Status (S, Interactive => False);
--
-- Clean up temporary files.
--
Io.Reset (File => Error_File,
Mode => Io.Out_File);
Logger.Note ("Executing command """ & Rm_Command & '"');
Ro.Execute (Command => Rm_Command,
In_Context => In_Context,
Input => Null_Input_File,
Output => Io.Convert (Error_File),
Error => Io.Convert (Error_File),
Status => S,
Timeout => Ro.Wait_Forever);
--
-- Process the error file and close it.
--
Io.Reset (File => Error_File,
Mode => Io.In_File);
while not Io.End_Of_File (Error_File) loop
declare
The_Line : constant String := Io.Get_Line (Error_File);
begin
if Su.Locate (Fragment => "ERROR", Within => The_Line) = 0 then
Logger.Debug (The_Line);
else
Logger.Error (The_Line);
end if;
end;
end loop;
Io.Close (Error_File);
Logger.Status (S, Interactive => False);
--
-- Process the output file and close it.
--
Io.Reset (File => Output_File,
Mode => Io.In_File);
while not Io.End_Of_File (Output_File) loop
Process (State => State,
Line => Io.Get_Line (Output_File));
end loop;
Io.Close (Output_File);
Status := S;
exception
when Profile.Error =>
Ss.Create_Condition
(Status => S,
Error_Type => "",
Message => "asaopen execution is quitting after errors",
Severity => Ss.Problem);
Status := S;
when Template_Error =>
Ss.Create_Condition
(Status => S,
Error_Type => "Asaopen",
Message => "syntax error in template or template not found",
Severity => Ss.Problem);
Status := S;
when others =>
Ss.Create_Condition (Status => S,
Error_Type => "Asaopen",
Message => "execution aborted by exception " &
Debug_Tools.Get_Exception_Name,
Severity => Ss.Problem);
Status := S;
end Execute;
end Asaopen;