|
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 - metrics - downloadIndex: B T
Length: 24881 (0x6131)
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 Asaopen;
with Device_Independent_Io;
with Job_Segment;
with Gateway_Object;
separate (Actions)
package body Model is
package Asac renames Asa_Definitions.Commands;
package Diio renames Device_Independent_Io;
Annotations : constant String :=
Asa_Definitions.Main_Class_Directory & ".ANNOTATIONS";
Annotation_Types : constant String :=
Asa_Definitions.Main_Class_Directory & ".ANNOTATION_TYPES";
Associated : constant String :=
Asa_Definitions.Main_Class_Directory & ".ASSOCIATED";
procedure Image_Name (Handle : Dc.Gateway_Handle;
Visible : Boolean;
Read_Only : Boolean;
No_Image : out Boolean;
Show_Property_Image : out Boolean;
Id : out Dc.Image_Identity) is
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Handle);
S : Ss.Condition;
begin
Show_Property_Image := False;
Id := (I1 => Dir.Unique (Gateway_Object), I2 => 0);
No_Image := True;
if not Read_Only then
S := Check_Writeable (Handle);
Logger.Status (S);
end if;
exception
when Profile.Error =>
Logger.Error ("Image construction is quitting after errors",
Raise_Error => False);
end Image_Name;
procedure Build_Image (Handle : Dc.Gateway_Handle;
Visible : Boolean;
In_Place : Boolean;
First_Time : Boolean;
Read_Only : in out Boolean;
Image : Dc.Image_Id;
No_Image : out Boolean;
Underlying_Object : out Directory.Object) is
Action_Id : Action.Id;
C : Ro.Context;
Directory_Exists : Boolean;
File_Exists : Boolean;
Has_Destroyed_Gateway : Boolean;
S : Ss.Condition;
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Handle);
Gateway_Full_Name : constant String :=
Dir.Naming.Get_Full_Name (Gateway_Object);
Host : constant String := Asap.Data_Host (Handle);
Model : constant String := Asap.Data_Context (Handle) &
Unix.Context_Separator &
Asap.Data_Name (Handle);
use Gateways;
begin
No_Image := True;
Underlying_Object := Gateway_Object;
if not Read_Only then
if Ss.Error (Check_Writeable (Handle)) then
return;
end if;
end if;
Ro.Acquire (A_Context => C,
Status => S,
Machine => Host,
Instance => Asa_Definitions.Asa);
Logger.Status (S, Interactive => True);
if not Is_Up_To_Date (Handle, In_Context => C) then
case Asas.Action_When_Out_Of_Date is
when Asas.Abandon =>
Logger.Negative
("The gateway object " & Gateway_Full_Name &
" may not be up-to-date. Use Asa.Accept_Changes " &
"to update it");
when Asas.Accept_Changes =>
Logger.Positive
("The gateway object " & Gateway_Full_Name &
" may not be up-to-date. Changes are being accepted");
Gwo.Close (Handle, S);
Logger.Status (S, Interactive => True);
Action_Id := Action.Start;
Accept_Changes
(Gateway_Object => Gateway_Object,
In_Context => C,
Model => Model,
Comments => "Automatic Accept_Changes issued by " &
"Build_Image from object " &
Gateway_Full_Name,
Work_Order => "<DEFAULT>",
Action_Id => Action_Id,
Has_Destroyed_Gateway => Has_Destroyed_Gateway);
Action.Finish (The_Action => Action_Id, Do_Commit => True);
if Has_Destroyed_Gateway then
Logger.Error
("Gateway object " & Gateway_Full_Name &
" has been destroyed while accepting changes. " &
"Unable to create an image for it.");
else
Gwo.Open_Object (Object => Gateway_Full_Name,
Slot => Gwo.Main_Slot,
H => Handle,
Errors => S);
Logger.Status (S, Interactive => True);
end if;
when Asas.Continue =>
Logger.Warning ("The gateway object " & Gateway_Full_Name &
" may not be up-to-date.");
end case;
end if;
--
-- Before calling asaedit we check the existence of the file,
-- because asaedit won't tell much it they do not exist.
--
Ro.File_Exists (The_File => Asap.Data_Context (Handle),
In_Context => C,
Status => S,
Exists => Directory_Exists);
Logger.Status (S);
if Directory_Exists then
if Read_Only then
Ro.File_Exists
(The_File =>
Asap.Data_Context (Handle) & Unix.Context_Separator &
Asap.Data_Name (Handle),
In_Context => C,
Status => S,
Exists => File_Exists);
Logger.Status (S);
if not File_Exists then
Logger.Negative ("Remote file " &
Asap.Data_Context (Handle) &
Unix.Context_Separator &
Asap.Data_Name (Handle) &
" does not exist");
end if;
end if;
else
Logger.Negative ("Remote directory " &
Asap.Data_Context (Handle) & " does not exist");
end if;
declare
Remote_Annotations : constant String :=
Unix.Temporary_Filename (Asac.Annotations_Extension);
Remote_Annotation_Types : constant String :=
Unix.Temporary_Filename (Asac.Annotation_Types_Extension);
Asaedit_Command : constant String :=
Asas.Bin_Directory (Asap.Data_Host (Handle)) &
Unix.Context_Separator &
Asac.Asaedit &
' ' &
Asap.Data_Context (Handle) &
Unix.Context_Separator &
Asap.Data_Name (Handle) &
' ' &
Asac.Start_Node &
' ' &
Asap.Asa_Node_Number (Handle) &
' ' &
Asac.No_Warnings &
' ' &
Asac.Annotations &
' ' &
Remote_Annotations &
' ' &
Asac.Annotation_Types &
' ' &
Remote_Annotation_Types;
Rm_Command : constant String := Unix.Remove &
' ' &
Remote_Annotations &
' ' &
Remote_Annotation_Types;
begin
Logger.Note ("Copying file " & Annotations &
" to " & Remote_Annotations);
Ro.Put (From_File => Annotations,
To_File => Remote_Annotations,
In_Context => C,
Status => S);
Logger.Status (S, Interactive => True);
Logger.Note ("Copying file " & Annotation_Types &
" to " & Remote_Annotation_Types);
Ro.Put (From_File => Annotation_Types,
To_File => Remote_Annotation_Types,
In_Context => C,
Status => S);
Logger.Status (S, Interactive => True);
if Read_Only then
Execute (Command => Asaedit_Command &
' ' &
Asac.Read_Only &
Unix.Command_Separator &
Rm_Command,
Interactive => True,
In_Context => C,
Timeout => Ro.Wait_Forever);
else
Execute (Command => Asaedit_Command &
Unix.Command_Separator &
Rm_Command,
Interactive => True,
In_Context => C,
Timeout => Ro.Wait_Forever);
end if;
end;
Ro.Release (A_Context => C, Status => S);
Logger.Status (S, Interactive => True);
exception
when Profile.Error =>
Logger.Error ("Image construction is quitting after errors",
Raise_Error => False);
end Build_Image;
--[bug]
-- Due to a bug in DISPATCH, the CMVC operations are called with an
-- handle that it not open under the action used for the operation.
-- To avoid locking problems, we immediately close the handle and
-- reopen the same object with the appropriate action. However there
-- is still an interesting issue: when the handle is reopen for the
-- post operation (with a new action), a locking error may be
-- detected, and the post operation may be called with a closed
-- handle. We have to live with this...
--
function Reopen (Handle : in Gwo.Handle; Action_Id : in Action.Id)
return Gwo.Handle is
Result : Gwo.Handle;
S : Ss.Condition;
The_Object : constant Dir.Object := Gwo.Directory_Object (Handle);
begin
Gwo.Close (Handle);
Gwo.Open_Main_Object (Object => The_Object,
H => Result,
Update => False,
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
return Result;
end Reopen;
procedure Pre_Check_In (Handle : Dc.Gateway_Handle;
Subobject : Directory.Object;
Response : Profile.Response_Profile;
Action_Id : Action.Id;
Errors : in out Dc.Error_Counts) is
The_Handle : Dc.Gateway_Handle := Reopen (Handle, Action_Id);
C : Ro.Context;
Has_Destroyed_Gateway : Boolean;
S : Ss.Condition;
The_Action : Action.Id := Action_Id;
Gateway_Object : constant Dir.Object :=
Gwo.Directory_Object (The_Handle);
Gateway_Full_Name : constant String :=
Dir.Naming.Get_Full_Name (Gateway_Object);
Host : constant String := Asap.Data_Host (The_Handle);
Model : constant String := Asap.Data_Context (The_Handle) &
Unix.Context_Separator &
Asap.Data_Name (The_Handle);
begin
Profile.Set (Response);
Ro.Acquire (A_Context => C,
Status => S,
Machine => Host,
Instance => Asa_Definitions.Asa);
Logger.Status (S, Interactive => True);
if not Is_Up_To_Date (The_Handle, In_Context => C) then
Logger.Positive ("Accepting changes from model " & Model);
Gwo.Close (The_Handle, S);
Logger.Status (S, Interactive => True);
Accept_Changes
(Gateway_Object => Gateway_Object,
In_Context => C,
Model => Model,
Comments => "Automatic Accept_Changes issued by " &
"Check_In from object " & Gateway_Full_Name,
Work_Order => "<DEFAULT>",
Action_Id => Action_Id,
Has_Destroyed_Gateway => Has_Destroyed_Gateway);
if Has_Destroyed_Gateway then
Logger.Warning ("The gateway object " & Gateway_Full_Name &
" has been destroyed while accepting " &
"changes. Cmvc.Check_In is unable to proceed");
Action.Finish (The_Action => The_Action, Do_Commit => True);
Errors := (Warnings => 0, Errors => 0, Fatal => True);
return;
end if;
end if;
Ro.Release (A_Context => C, Status => S);
Logger.Status (S, Interactive => True);
Errors := (Warnings => 0, Errors => 0, Fatal => False);
exception
when Profile.Error =>
Errors := (Warnings => 0, Errors => 1, Fatal => False);
end Pre_Check_In;
procedure Pre_Cmvc_Copy (Handle : Dc.Gateway_Handle;
Subobject : Directory.Object;
Release : Boolean;
Controlled : Boolean;
Joined : Boolean;
Source_View : Directory.Object;
Destination_View : Directory.Object;
First_Call : Boolean;
Do_Not_Copy : out Boolean;
Response : Profile.Response_Profile;
Action_Id : Action.Id;
Errors : in out Dc.Error_Counts) is
The_Handle : Dc.Gateway_Handle := Reopen (Handle, Action_Id);
C : Ro.Context;
Has_Destroyed_Gateway : Boolean;
S : Ss.Condition;
The_Action : Action.Id := Action_Id;
Gateway_Object : constant Dir.Object :=
Gwo.Directory_Object (The_Handle);
Gateway_Full_Name : constant String :=
Dir.Naming.Get_Full_Name (Gateway_Object);
Host : constant String := Asap.Data_Host (The_Handle);
Model : constant String := Asap.Data_Context (The_Handle) &
Unix.Context_Separator &
Asap.Data_Name (The_Handle);
begin
Profile.Set (Response);
Ro.Acquire (A_Context => C,
Status => S,
Machine => Host,
Instance => Asa_Definitions.Asa);
Logger.Status (S, Interactive => True);
if not Is_Up_To_Date (The_Handle, In_Context => C) then
Logger.Positive ("Accepting changes from model " & Model);
Gwo.Close (The_Handle, S);
Logger.Status (S, Interactive => True);
Accept_Changes (Gateway_Object => Gateway_Object,
In_Context => C,
Model => Model,
Comments => "Automatic Accept_Changes issued by " &
"view copy" & Gateway_Full_Name,
Work_Order => "<DEFAULT>",
Action_Id => Action_Id,
Has_Destroyed_Gateway => Has_Destroyed_Gateway);
end if;
Ro.Release (A_Context => C, Status => S);
Logger.Status (S, Interactive => True);
Errors := (Warnings => 0, Errors => 0, Fatal => False);
Do_Not_Copy := False;
exception
when Profile.Error =>
Errors := (Warnings => 0, Errors => 1, Fatal => False);
Do_Not_Copy := True;
end Pre_Cmvc_Copy;
procedure Post_Cmvc_Copy (Handle : Dc.Gateway_Handle;
Subobject : Directory.Object;
Source_Object : Directory.Object;
Release : Boolean;
Controlled : Boolean;
Joined : Boolean;
Source_View : Directory.Object;
Destination_View : Directory.Object;
First_Call : Boolean;
Response : Profile.Response_Profile;
Action_Id : Action.Id;
Errors : in out Dc.Error_Counts) is
The_Handle : Dc.Gateway_Handle := Reopen (Handle, Action_Id);
Archive_File : Diio.File_Type;
C : Ro.Context;
S : Ss.Condition;
type Access_String is access String;
pragma Segmented_Heap (Access_String);
Context : constant String := Asap.Data_Context (The_Handle);
Host : constant String := Asap.Data_Host (The_Handle);
Model : constant String := Context & Unix.Context_Separator &
Asap.Data_Name (The_Handle);
Gateway_Object : constant Dir.Object :=
Gwo.Directory_Object (The_Handle);
Archive_File_Name : constant String :=
Dna.Get_Full_Name (Gateway_Object) & ".Archive";
Remote_Tarfile : constant String :=
Unix.Temporary_Filename (Unix.Tarfile_Extension);
Cd_Command : constant String := Unix.Change_Directory &
' ' &
Context;
Tar_Command : constant String := Unix.Tape_Archive &
' ' &
Unix.Create &
Unix.Archive_File &
' ' &
Remote_Tarfile &
' ' &
Model;
Rm_Command : constant String := Unix.Remove &
' ' &
Remote_Tarfile;
My_State : Access_String;
procedure Process (State : in out Access_String;
Line : in String) is
begin
pragma Assert (State = null);
State := new String'(Line);
pragma Heap (Job_Segment.Get);
end Process;
procedure Execute_Script is
new Asaopen.Execute (State_Record => Access_String,
Process => Process);
begin
if Release then
Profile.Set (Response);
--
-- Acquire a connection.
--
Ro.Acquire (A_Context => C,
Status => S,
Machine => Host,
Instance => Asa_Definitions.Asa);
Logger.Status (S);
--
-- Find the associated files.
--
Execute_Script (In_Context => C,
Model => Model,
Template_Name => Associated,
State => My_State,
Status => S);
Logger.Status (S);
--
-- Archive all the files, from the appropriate directory.
--
Execute (Command => Cd_Command &
Unix.Command_Separator &
Tar_Command &
' ' &
My_State.all,
Interactive => False,
In_Context => C,
Timeout => Default_Timeout);
--
-- Upload the tar file.
--
Diio.Create (File => Archive_File,
Mode => Diio.Out_File,
Name => Archive_File_Name,
Action_Id => Gwo.Action_Id (The_Handle));
Ro.Get (From_File => Remote_Tarfile,
In_Context => C,
To_File => Archive_File,
Status => S);
Logger.Status (S);
Diio.Close (File => Archive_File);
--
-- Delete the remote tarfile.
--
Execute (Command => Rm_Command,
Interactive => False,
In_Context => C,
Timeout => Default_Timeout);
--
-- Release the connection.
--
Ro.Release (A_Context => C, Status => S);
Logger.Status (S);
end if;
Errors := (Warnings => 0, Errors => 0, Fatal => False);
exception
when Profile.Error =>
Errors := (Warnings => 0, Errors => 1, Fatal => True);
end Post_Cmvc_Copy;
procedure Pre_Make_Controlled (Handle : Dc.Gateway_Handle;
Subobject : Directory.Object;
Save_Source : Boolean;
Allow_Controlled : out Boolean;
Response : Profile.Response_Profile;
Action_Id : Action.Id;
Errors : in out Dc.Error_Counts) is
The_Handle : Dc.Gateway_Handle := Reopen (Handle, Action_Id);
C : Ro.Context;
Has_Destroyed_Gateway : Boolean;
S : Ss.Condition;
The_Action : Action.Id := Action_Id;
Gateway_Object : constant Dir.Object :=
Gwo.Directory_Object (The_Handle);
Gateway_Full_Name : constant String :=
Dir.Naming.Get_Full_Name (Gateway_Object);
Host : constant String := Asap.Data_Host (The_Handle);
Model : constant String := Asap.Data_Context (The_Handle) &
Unix.Context_Separator &
Asap.Data_Name (The_Handle);
begin
Profile.Set (Response);
Allow_Controlled := True;
if Save_Source then
Logger.Negative (Asa_Definitions.Asa &
" gateway objects cannot be source-controlled");
Errors := (Warnings => 0, Errors => 1, Fatal => False);
else
Ro.Acquire (A_Context => C,
Status => S,
Machine => Host,
Instance => Asa_Definitions.Asa);
Logger.Status (S, Interactive => True);
if not Is_Up_To_Date (The_Handle, In_Context => C) then
Logger.Positive ("Accepting changes from model " & Model);
Gwo.Close (The_Handle, S);
Logger.Status (S, Interactive => True);
Accept_Changes
(Gateway_Object => Gateway_Object,
In_Context => C,
Model => Model,
Comments => "Automatic Accept_Changes issued by " &
"Cmvc.Make_Controlled from object " &
Gateway_Full_Name,
Work_Order => "<DEFAULT>",
Action_Id => Action_Id,
Has_Destroyed_Gateway => Has_Destroyed_Gateway);
if Has_Destroyed_Gateway then
Logger.Warning ("The gateway object " & Gateway_Full_Name &
" has been destroyed while accepting " &
"changes. Cmvc.Make_Controlled is " &
"unable to proceed");
Action.Finish (The_Action => The_Action, Do_Commit => True);
Errors := (Warnings => 0, Errors => 0, Fatal => True);
return;
end if;
end if;
Ro.Release (A_Context => C, Status => S);
Logger.Status (S, Interactive => True);
Errors := (Warnings => 0, Errors => 0, Fatal => False);
end if;
exception
when Profile.Error =>
Errors := (Warnings => 0, Errors => 1, Fatal => False);
end Pre_Make_Controlled;
procedure Terminate_Server (Reason : in Dc.Termination_Condition) is
begin
if Reason = Dc.Gateway_Class_Deactivated then
Switch_Registration.Stop;
end if;
end Terminate_Server;
end Model;