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

⟦474fc807f⟧ TextFile

    Length: 10174 (0x27be)
    Types: TextFile
    Names: »B«

Derivation

└─⟦25882cbde⟧ Bits:30000536 8mm tape, Rational 1000, RCI_RS6000_AIX_IBM 2_0_2
    └─ ⟦b8efda8ac⟧ »DATA« 
        └─⟦7061b4ee8⟧ 
            └─⟦this⟧ 

TextFile

with Activity;
with Archive;
with Debug_Tools;  
with Directory_Tools;
with Log;
with Links;
with Profile;
with Program;
with Simple_Status;
with String_Utilities;

procedure Install_Customization (Target_Key : String := "<DEFAULT>";
                                 Release_Number : String := "<DEFAULT>";
                                 Version : String := "<DEFAULT>") is
    Bad_Current_Context : exception;

    Def_Con : constant String := Directory_Tools.Naming.Default_Context;

    Install_World_Prefix : constant String := "!Targets.Implementation.Release";

    Profile_Kind : array (Simple_Status.Condition_Class) of Profile.Msg_Kind :=
       (Simple_Status.Normal => Profile.Note_Msg,
        Simple_Status.Warning => Profile.Warning_Msg,
        Simple_Status.Problem => Profile.Error_Msg,
        Simple_Status.Fatal => Profile.Error_Msg);

    function Default_Release_Suffix return String is
    begin
        if Install_World_Prefix'Length < Def_Con'Length and then
           String_Utilities.Equal
              (Install_World_Prefix,
               Def_Con (Def_Con'First ..
                           Def_Con'First + Install_World_Prefix'Length - 1),
               Ignore_Case => True) then
            return Def_Con (Def_Con'First + Install_World_Prefix'Length ..
                               Def_Con'Last);

        else

            raise Bad_Current_Context;

        end if;
    end Default_Release_Suffix;

    function Get_Target_Key return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));


                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));


            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Release_Suffix'First + 1 ..
                                              Third_To_Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Target_Key;

    function Get_Release_Number return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));
                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));

            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Third_To_Last_Underscore + 1 ..
                                              Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Release_Number;

    function Get_Version return String is
    begin
        if String_Utilities.Equal
              (Version, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
            begin
                if Last_Underscore > Release_Suffix'First then
                    return Release_Suffix
                              (Last_Underscore .. Release_Suffix'Last);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Version;
        end if;
    end Get_Version;

    function Release_World return String is
    begin
        return "!targets.implementation.release_" & Get_Target_Key &
                  "_" & Get_Release_Number & Get_Version;
    end Release_World;

    procedure Register_Target is  
        Key : constant String := Get_Target_Key;
        The_Job : Program.Job_Id;
        Status : Program.Condition;

    begin
        Log.Put_Line ("Registering target " & Key);
        Program.Create_Job (S => Key & ".register",
                            Job => The_Job,
                            Status => Status,
                            Debug => False,
                            Context => "$",
                            After => 0.0,
                            Options => "",
                            Response => "<PROFILE>");
        if Simple_Status.">=" (Simple_Status.Severity (Status),
                               Simple_Status.Problem) then
            Log.Put_Line (Simple_Status.Display_Message (Status),
                          Profile_Kind (Simple_Status.Severity (Status)));
            Log.Put_Line ("Can't register " & Key, Profile.Error_Msg);
            raise Program_Error;
        else
            Program.Wait_For (The_Job);
        end if;
        Log.Put_Line ("Successfully registered target " & Key);
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Register_Target");
            raise;
    end Register_Target;

    procedure Do_Restore_Predefined is
    begin
        Log.Put_Line ("Restoring predefined world");
        Archive.Restore (Objects => "[?,~!Targets." & Get_Target_Key & "]",
                         Use_Prefix => "*",
                         For_Prefix => "*",
                         Options => "changed_objects replace",
                         Device => Release_World & ".predefined_archive",
                         Response => "<PROFILE>");
        Log.Put_Line ("Successfully restored predefined world");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Restore_Predefined",
                          Kind => Profile.Error_Msg);  
            raise;
    end Do_Restore_Predefined;


    procedure Restore_Predefined is
        Predefined_World : Directory_Tools.Object.Handle :=
           Directory_Tools.Naming.Resolution ("!targets." & Get_Target_Key);
    begin
        if Directory_Tools.Object.Is_Ok (Predefined_World) then
            Register_Target;
        end if;
        Do_Restore_Predefined;
    end Restore_Predefined;

    procedure Merge_Activities is
    begin
        Log.Put_Line
           ("Merging " & Release_World &
            ".install_activity into !machine.release.current.activity");
        Activity.Merge (Source => Release_World & ".install_activity",
                        Subsystem => "?",
                        Spec_View => "?",
                        Load_View => "?",
                        Mode => Activity.Exact_Copy,
                        Target => "!machine.release.current.activity",
                        Response => "<PROFILE>");  
        Log.Put_Line ("Successfully merged activities");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Merge_Activities",
                          Kind => Profile.Error_Msg);
            raise;
    end Merge_Activities;


    procedure Replace_Links is
        Key : constant String := Get_Target_Key;
    begin
        Log.Put_Line ("Replacing link to " & Key);
        Links.Replace (Source => "!targets.implementation.Rci_customization." &
                                    Key & "'spec_view.units." & Key,
                       Link => "#",
                       World => "!machine.release.current.commands",
                       Response => "<PROFILE>");
        Log.Put_Line ("Successfully replaced link");
    exception
        when others =>
            Log.Put_Line (Message => "Unable to define link to " & Key,
                          Kind => Profile.Warning_Msg);
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Replace_Links");
    end Replace_Links;

begin
    Merge_Activities;
    Replace_Links;
    Restore_Predefined;
    -- May require registering target if predefined world preexists.
    --Register_Target;
exception
    when Bad_Current_Context =>
        Log.Put_Line ("Unable to install " & Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
    when others =>
        Log.Put_Line ("Unable to install " & Get_Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
end Install_Customization;