⟦91ba0ea0a⟧

TextFile

with Action;
with Asa_Definitions;
with Calendar;
with Debug_Tools;
with Directory;
with Gateways;
with Gateway_Object;
with Hierarchy;
with Logger;
with Object_Class;
with Object_Subclass;
with Profile;
with Simple_Status;
with Unix_Definitions;
package body Asa is

    Package_Name : constant String := "Asa.";

    package Asap renames Asa_Definitions.Properties;
    package Dir renames Directory;
    package Dcp renames Directory.Control_Point;
    package Dna renames Directory.Naming;
    package Gwo renames Gateway_Object;  
    package Hchy renames Hierarchy;
    package Ss renames Simple_Status;
    package Unix renames Unix_Definitions;

    function Must_Raise_Error return Boolean is
        use Profile;
    begin
        return Profile.Reaction = Profile.Propagate or else
                  Profile.Reaction = Profile.Raise_Error;
    end Must_Raise_Error;

    procedure Check_Requirement_Name (Requirement_Name : in String;
                                      Action_Id : in Action.Id;
                                      Is_A_Requirement : out Boolean;
                                      Requirement_Object : out Dir.Object;
                                      Requirement_Handle : out Gwo.Handle) is
        E : Dir.Error_Status;
        Handle : Gwo.Handle;
        N : Dna.Name_Status;
        Object : Dir.Object;
        S : Ss.Condition;
        use Asa_Definitions;
        use Dna;
    begin  
        Dna.Resolve (Name => Requirement_Name,  
                     The_Object => Object,
                     Status => N);  
        if N /= Dna.Successful then
            Is_A_Requirement := False;
            Requirement_Object := Dir.Nil;
            Requirement_Handle := Gwo.Null_Handle;
        elsif Dir.Is_Gateway (Object) then
            Gwo.Open_Main_Object (Object => Object,
                                  H => Handle,
                                  Update => False,
                                  Action_Id => Action_Id,
                                  Errors => S);
            if Ss.Error (S) or else Asap.Class (Handle) /=
                                       Asa_Definitions.Asa_Requirement then
                Is_A_Requirement := False;
                Requirement_Object := Object;
                Requirement_Handle := Gwo.Null_Handle;
            else
                Is_A_Requirement := True;
                Requirement_Object := Object;
                Requirement_Handle := Handle;
            end if;
        end if;
    end Check_Requirement_Name;

    procedure Check_View_Name (View_Name : in String;  
                               Action_Id : in Action.Id;
                               Is_A_Combined_View : out Boolean;
                               View_Object : out Dir.Object) is
        E : Dir.Error_Status;
        N : Dna.Name_Status;
        Object : Dir.Object;
        View : Dir.Object;
        View_Subclass : Dir.Subclass;
        use Dir;
        use Dna;
    begin  
        Dna.Resolve (Name => View_Name,  
                     The_Object => Object,
                     Status => N,
                     Action_Id => Action_Id);  
        if N /= Dna.Successful then
            Is_A_Combined_View := False;
            View_Object := Dir.Nil;
        else
            if Dcp.Is_World (Object) then
                View := Object;
            else
                Dcp.Parent_World
                   (The_Object => Object, The_World => View, Status => E);
                if E /= Successful then
                    Is_A_Combined_View := False;
                    View_Object := Dir.Nil;
                end if;
            end if;
            View_Subclass := Dir.Get_Subclass (View);

            Is_A_Combined_View := View_Subclass =
                                     Object_Subclass.Combined_View_Subclass;
            View_Object := View;
        end if;
    end Check_View_Name;

    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;

    procedure Create_Requirement (For_Object : in String := "<CURSOR>";
                                  Name : in String := ">>Requirement Name<<";
                                  Kind : in Requirements.Non_Functional :=
                                     Requirements.Performance;
                                  Comments : in String := "";
                                  Work_Order : in String := "<DEFAULT>";
                                  Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Create_Requirement";
        S : Ss.Condition;
        The_Action : Action.Id;
        The_State : Gateways.State;
    begin
        Profile.Set (Response, S);
        The_Action := Action.Start;

        Gateways.Initialize (The_State => The_State,
                             Action_Id => The_Action,
                             Work_Order => Work_Order);
        Gateways.Create (In_Gateway => For_Object,
                         Requirement_Name => Name,
                         Requirement_Kind => Kind,
                         Requirement_Text => "",
                         Comments => Comments,
                         The_State => The_State);
        Gateways.Finalize (The_State);
        Action.Finish (The_Action, Do_Commit => True);
    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Create_Requirement;

    procedure Copy_Requirement (Requirement : in String := "<REGION>";
                                To_Object : in String := "<CURSOR>";
                                Comments : in String := "";
                                Work_Order : in String := "<DEFAULT>";
                                Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Copy_Requirement";
        Gateway : Gwo.Handle;  
        Gateway_Object : Dir.Object;
        Is_A_Requirement : Boolean;
        S : Ss.Condition;
        The_Action : Action.Id := Action.Start;
        The_State : Gateways.State;
    begin
        Profile.Set (Response, S);

        Check_Requirement_Name (Requirement_Name => Requirement,
                                Action_Id => The_Action,
                                Is_A_Requirement => Is_A_Requirement,
                                Requirement_Object => Gateway_Object,
                                Requirement_Handle => Gateway);
        if not Is_A_Requirement then
            if Dir.Is_Nil (Gateway_Object) then
                Logger.Negative (Requirement & " is not a gateway of class " &
                                 Asa_Definitions.Gateway_Class'Image
                                    (Asa_Definitions.Asa_Requirement));
            else
                Logger.Negative (Dna.Get_Full_Name (Gateway_Object) &
                                 " is not a gateway of class " &
                                 Asa_Definitions.Gateway_Class'Image
                                    (Asa_Definitions.Asa_Requirement));
            end if;
        end if;

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

        Gateways.Create (In_Gateway => To_Object,
                         Requirement_Name =>
                            Dna.Get_Simple_Name (Gateway_Object),
                         Requirement_Kind =>
                            Asap.Asa_Requirement_Kind (Gateway),
                         Requirement_Text =>
                            Asap.Asa_Requirement_Text (Gateway),
                         Comments => Comments,
                         The_State => The_State);

        Gateways.Finalize (The_State);
        Action.Finish (The_Action, Do_Commit => True);
    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Copy_Requirement;


    procedure Move_Requirement (Requirement : in String := "<REGION>";
                                To_Object : in String := "<CURSOR>";
                                Comments : in String := "";
                                Work_Order : in String := "<DEFAULT>";
                                Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Move_Requirement";
        Gateway : Gwo.Handle;  
        Gateway_Object : Dir.Object;
        Is_A_Requirement : Boolean;
        S : Ss.Condition;
        The_Action : Action.Id := Action.Start;
        The_State : Gateways.State;
    begin
        Profile.Set (Response, S);

        Check_Requirement_Name (Requirement_Name => Requirement,
                                Action_Id => The_Action,
                                Is_A_Requirement => Is_A_Requirement,
                                Requirement_Object => Gateway_Object,
                                Requirement_Handle => Gateway);
        if not Is_A_Requirement then
            if Dir.Is_Nil (Gateway_Object) then
                Logger.Negative (Requirement & " is not a gateway of class " &
                                 Asa_Definitions.Gateway_Class'Image
                                    (Asa_Definitions.Asa_Requirement));
            else
                Logger.Negative (Dna.Get_Full_Name (Gateway_Object) &
                                 " is not a gateway of class " &
                                 Asa_Definitions.Gateway_Class'Image
                                    (Asa_Definitions.Asa_Requirement));
            end if;
        end if;

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

        Gateways.Create (In_Gateway => To_Object,
                         Requirement_Name =>
                            Dna.Get_Simple_Name (Gateway_Object),
                         Requirement_Kind =>
                            Asap.Asa_Requirement_Kind (Gateway),
                         Requirement_Text =>
                            Asap.Asa_Requirement_Text (Gateway),
                         Comments => Comments,
                         The_State => The_State);

        Gateways.Destroy (Gateway_Name => Dna.Get_Full_Name (Gateway_Object),
                          Comments => Comments,
                          The_State => The_State);

        Gateways.Finalize (The_State);
        Action.Finish (The_Action, Do_Commit => True);
    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Move_Requirement;

    procedure Accept_Changes (In_Object : in String := "<CURSOR>";
                              Comments : in String := "";
                              Work_Order : in String := "<DEFAULT>";
                              Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Accept_Changes";
        Build_Time : Calendar.Time;
        E : Dir.Error_Status;
        Enclosing_Library : Dir.Object;
        Gateway : Gwo.Handle;  
        Gateway_Object : Dir.Object;
        Root_Iterator : Hchy.Module_Iterator;
        Root_Module : Hchy.Module;  
        S : Ss.Condition;  
        The_Action : Action.Id := Action.Start;
        The_State : Gateways.State;
    begin
        Profile.Set (Response, S);

        --
        -- Open the specified gateway.
        --
        Gwo.Open_Main_Object (Object => In_Object,
                              H => Gateway,
                              Update => False,
                              Action_Id => The_Action,
                              Errors => S);
        Logger.Status (S);

        Gateway_Object := Gwo.Directory_Object (Gateway);
        Dcp.Parent_Library (The_Object => Gateway_Object,
                            The_Library => Enclosing_Library,
                            Status => E);
        Logger.Status (E);

        declare
            Host : constant String := Asap.Data_Host (Gateway);
            Model : constant String := Asap.Data_Context (Gateway) &  
                                          Unix.Context_Separator &  
                                          Asap.Data_Name (Gateway);
        begin

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

            Gwo.Close (Gateway, Errors => S);
            Logger.Status (S);

            --
            -- Find the root of the gateway tree.
            --
            Gateway_Object := Root_Of (Gateway => Gateway_Object,
                                       Action_Id => The_Action);

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

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

            --
            -- Create gateways for the new modules.
            --
            Gateways.Augment
               (For_Module => Root_Module,
                In_Library => Dna.Get_Full_Name (Enclosing_Library),
                Host => Host,
                Model => Model,
                Update_Time => Build_Time,
                Comments => Comments,
                The_State => The_State);

            Gateways.Finalize (The_State);
            Action.Finish (The_Action, Do_Commit => True);
        end;

    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Accept_Changes;

    procedure Create_Model (Model : in String := ">>ASA Model Name<<";
                            Host : in String := ">>Machine Name<<";
                            Into_View : in String := "<CURSOR>";
                            Comments : in String := "";
                            Work_Order : in String := "<DEFAULT>";
                            Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Create_Model";
        S : Ss.Condition;  
        Build_Time : Calendar.Time;
        Is_A_Combined_View : Boolean;
        Root_Module : Hchy.Module;
        The_Action : Action.Id := Action.Start;
        The_State : Gateways.State;
        View : Dir.Object;
        use Dir;
    begin  
        Profile.Set (Response, S);

        Check_View_Name (View_Name => Into_View,
                         Action_Id => The_Action,
                         Is_A_Combined_View => Is_A_Combined_View,
                         View_Object => View);

        if not Is_A_Combined_View then
            if Dir.Is_Nil (View) then
                Logger.Negative (Into_View & " is not a combined view");
            else
                Logger.Negative (Dna.Get_Full_Name (View) &
                                 " is not a combined view");
            end if;
        end if;

        Root_Module := Hchy.Make (Identifier => Unix.Simple_Name (Model));

        Gateways.Initialize (The_State => The_State,
                             Action_Id => The_Action,
                             Work_Order => Work_Order);
        Gateways.Create (For_Module => Root_Module,
                         In_Library => Dna.Get_Full_Name (View) & ".Units",
                         Host => Host,
                         Model => Model,
                         Update_Time => Build_Time,
                         Comments => Comments,
                         The_State => The_State);
        Gateways.Finalize (The_State);
        Action.Finish (The_Action, Do_Commit => True);
    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Create_Model;

    procedure Import_Model (Model : in String := ">>ASA Model Name<<";
                            Host : in String := ">>Machine Name<<";
                            Into_View : in String := "<CURSOR>";
                            Comments : in String := "";
                            Work_Order : in String := "<DEFAULT>";
                            Response : in String := "<PROFILE>") is
        Subprogram_Name : constant String := "Import_Model";
        S : Ss.Condition;  
        Build_Time : Calendar.Time;
        Is_A_Combined_View : Boolean;
        Root_Module : Hchy.Module;
        The_Action : Action.Id := Action.Start;
        The_State : Gateways.State;
        View : Dir.Object;
        use Dir;
    begin  
        Profile.Set (Response, S);

        Check_View_Name (View_Name => Into_View,
                         Action_Id => The_Action,
                         Is_A_Combined_View => Is_A_Combined_View,
                         View_Object => View);

        if not Is_A_Combined_View then
            if Dir.Is_Nil (View) then
                Logger.Negative (Into_View & " is not a combined view");
            else
                Logger.Negative (Dna.Get_Full_Name (View) &
                                 " is not a combined view");
            end if;
        end if;

        Logger.Note ("Building module hierarchy for model " & Model);
        Hchy.Build (Model => Model,  
                    Host => Host,
                    Root => Root_Module,
                    Build_Time => Build_Time);

        Gateways.Initialize (The_State => The_State,
                             Action_Id => The_Action,
                             Work_Order => Work_Order);
        Gateways.Create (For_Module => Root_Module,
                         In_Library => Dna.Get_Full_Name (View) & ".Units",
                         Host => Host,
                         Model => Model,
                         Update_Time => Build_Time,
                         Comments => Comments,
                         The_State => The_State);
        Gateways.Finalize (The_State);
        Action.Finish (The_Action, Do_Commit => True);
    exception
        when Profile.Error =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " is quitting after errors",
                          Raise_Error => Must_Raise_Error);
        when others =>
            Logger.Error (Package_Name & Subprogram_Name &
                          " aborted by exception " &
                          Debug_Tools.Get_Exception_Name,
                          Raise_Error => Must_Raise_Error);
            Action.Finish (The_Action, Do_Commit => False);
    end Import_Model;

end Asa;
DataMuseum.dk

Rational R1000/400 Tapes

⟦91ba0ea0a⟧ TextFile

Derivation

TextFile
