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

⟦27f0621b3⟧ TextFile

    Length: 24881 (0x6131)
    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 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;