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

⟦809a58710⟧ TextFile

    Length: 10409 (0x28a9)
    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 Action;
with Asa_Definitions;
with Calendar;
with Directory;
with Gateway_Object;
with Gateways;
with Hierarchy;
with Logger;
with Object_Class;
with Profile;
with Remote_Operations;
with Simple_Status;
with String_Utilities;
with Unix_Definitions;
pragma Elaborate (Asa_Definitions);
package body Actions is

    package Asas renames Asa_Definitions.Switches;
    package Asap renames Asa_Definitions.Properties;
    package Dir renames Directory;
    package Dna renames Directory.Naming;
    package Gwo renames Gateway_Object;
    package Hchy renames Hierarchy;
    package Ro renames Remote_Operations;
    package Ss renames Simple_Status;
    package Su renames String_Utilities;
    package Unix renames Unix_Definitions;

    --
    -- The following task keeps this package elaborated as long as its
    -- STOP entry is  not called.
    --
    Switch_Registration : Asas.Register;

    Default_Timeout : constant := 60.0;


    --                    ---------------------
    --                    ( ) Gateway utilities
    --                    ---------------------


    function Root_Of (Gateway : in Dir.Object; Action_Id : in Action.Id)
                     return Dir.Object is
        E : Dir.Error_Status;
        Gateway_Data : Dir.Statistics.Object_Data;
        Result : Dir.Object;
        use Dir;
    begin
        Result := Gateway;
        loop
            Dir.Statistics.Get_Object_Data (The_Object => Result,
                                            The_Data => Gateway_Data,
                                            Status => E,
                                            Action_Id => Action_Id);
            exit when Dir.Get_Class
                         (Dir.Statistics.Object_Parent (Gateway_Data)) =
                      Object_Class.Library;
            Result := Dir.Statistics.Object_Parent (Gateway_Data);
        end loop;
        return Result;
    end Root_Of;


    --                    ------------
    --                    ( ) Currency
    --                    ------------


    procedure Accept_Changes (Gateway_Object : in Dir.Object;
                              In_Context : in Ro.Context;
                              Model : in String;
                              Comments : in String;
                              Work_Order : in String;
                              Action_Id : in Action.Id;
                              Has_Destroyed_Gateway : out Boolean) is
        Build_Time : Calendar.Time;
        Root_Gateway : Dir.Object;
        Root_Iterator : Hchy.Module_Iterator;
        Root_Module : Hchy.Module;
        The_State : Gateways.State;
    begin

        --
        -- Compute module hierarchy for the associated model.
        --
        Logger.Note ("Building module hierarchy for model " & Model);
        Hchy.Build (Model => Model,  
                    In_Context => In_Context,
                    Root => Root_Module,
                    Build_Time => Build_Time);
        Root_Iterator := Hchy.Make (Root_Module);

        Root_Gateway := Root_Of (Gateway_Object, Action_Id => Action_Id);

        Gateways.Initialize (The_State => The_State,
                             Action_Id => Action_Id,
                             Work_Order => Work_Order);

        --
        -- Delete those gateways that no longer have corresponding
        -- modules.
        --
        Gateways.Reduce (Gateway_Name =>
                            Dir.Naming.Get_Full_Name (Root_Gateway),
                         Candidate_Modules => Root_Iterator,
                         Comments => Comments,
                         The_State => The_State);

        --
        -- Create gateways for the new modules.
        --
        Gateways.Augment
           (For_Module => Root_Module,
            In_Library => Dir.Naming.Get_Full_Name
                             (Dir.Control_Point.Associated_Control_Point
                                 (Root_Gateway)),
            Host => Ro.Machine (In_Context),
            Model => Model,
            Update_Time => Build_Time,
            Comments => Comments,
            The_State => The_State);

        Gateways.Finalize (The_State);

        Has_Destroyed_Gateway :=
           Dir.Naming.Get_Full_Name (Gateway_Object) =
              '[' & Dir.Error_Status'Image (Dir.Version_Error) & ']';
    end Accept_Changes;

    function Is_Up_To_Date (Handle : Dc.Gateway_Handle;  
                            In_Context : in Ro.Context) return Boolean is
        Remote_Update_Time : Calendar.Time;
        S : Ss.Condition;
        use Calendar;
    begin
        Ro.Update_Time (Of_File => Asap.Data_Context (Handle) &  
                                      Unix.Context_Separator &  
                                      Asap.Data_Name (Handle),
                        In_Context => In_Context,
                        Result => Remote_Update_Time,
                        Status => S,
                        Options => "");
        if Ss.Error (S) then

            --
            -- If the remote file does not exist, we assume that the
            -- gateway is up to date.
            --
            return True;
        end if;
        return Remote_Update_Time <= Asap.Asa_Update_Time (Handle);
    end Is_Up_To_Date;


    --                    ---------------------
    --                    ( ) Command execution
    --                    ---------------------


    procedure Execute (Command : in String;
                       Interactive : in Boolean;
                       In_Context : in Ro.Context;
                       Timeout : in Ro.Command_Timeout := Default_Timeout) is

        --
        -- Interactive commands do require the definition of the X Window
        -- display.  Also, it is not necessary to log messages indicating
        -- what is going on during such commands.
        --

        type State_Record is
            record
                null;
            end record;

        The_Display : constant String := Asas.Remote_Display;
        Setenv_Display : constant String := Unix.Setenv &  
                                               ' ' &  
                                               Unix.Display &  
                                               ' ' &  
                                               The_Display;

        S : Ss.Condition;
        The_State : State_Record;


        procedure Process_Output (Text : String;
                                  Severity : Profile.Msg_Kind;
                                  State : in out State_Record;
                                  Response : in out Ro.Command_Response) is
        begin  
            if Interactive then
                Logger.Debug (Text);
            else
                Logger.Note (Text);
            end if;
            Response := Ro.Nil;  
        end Process_Output;

        procedure Read_Input (State : in out State_Record;
                              Buffer : out String;
                              Last : out Natural;
                              Response : in out Ro.Command_Response) is
        begin
            Last := 0;
            Response := Ro.Abort_Command;
            Logger.Error ("Attempt to read input during command execution");
        end Read_Input;

        procedure Timeout_Handler (State : in out State_Record;
                                   Response : in out Ro.Command_Response) is
        begin
            Response := Ro.Abort_Command;
            Logger.Error ("Timeout expired during command execution");
        end Timeout_Handler;

        procedure Execute is new Ro.Execution_Generic
                                    (Execution_State => State_Record,
                                     Process_Output => Process_Output,
                                     Read_Input => Read_Input,
                                     Timeout_Handler => Timeout_Handler);

    begin
        if Interactive then
            if The_Display /= "" then
                Logger.Debug ("Executing command """ & Setenv_Display & '"');
                Execute (Command => Setenv_Display,
                         In_Context => In_Context,
                         State => The_State,
                         Status => S,
                         Timeout => Default_Timeout);
                Logger.Status (S, Interactive => True);
            end if;
        end if;

        if Interactive then
            Logger.Debug ("Executing command """ & Command & '"');
        else
            Logger.Note ("Executing command """ & Command & '"');
        end if;
        Execute (Command => Command,
                 In_Context => In_Context,
                 State => The_State,
                 Status => S,
                 Timeout => Timeout);
        Logger.Status (S, Interactive => Interactive);
    end Execute;


    --                    ------------------
    --                    ( ) Image creation
    --                    ------------------


    function Check_Writeable (H : in Gwo.Handle) return Ss.Condition is
        Gateway_Object : constant Dir.Object := Gwo.Directory_Object (H);
        Gateway_Full_Name : constant String :=
           Dna.Get_Full_Name (Gateway_Object);
        S : Ss.Condition;
        The_Handle : Dc.Gateway_Handle := H;
    begin
        case Gateways.Cmvc_Control (Gateway_Full_Name) is

            when Gateways.Not_Controlled |  
                 Gateways.Controlled_Checked_Out =>

                if Gwo.Is_Main_Object_Open_For_Update (H) then
                    Ss.Initialize (S);
                else
                    Gwo.Re_Open_Main_Object_For_Update
                       (The_Handle, Errors => S);
                end if;
                return S;
            when Gateways.Controlled_Checked_In =>
                Ss.Create_Condition
                   (Status => S,
                    Error_Type => "",
                    Message =>
                       "Unable to obtain gateway object " & Gateway_Full_Name &
                          "; it must be checked-out before it can be edited",
                    Severity => Ss.Problem);
                return S;
        end case;
    end Check_Writeable;


    --                    ---------
    --                    ( ) Stubs
    --                    ---------


    package body Model is separate;

    package body Module is separate;

    package body Requirement is separate;

end Actions;