|
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 - downloadIndex: ┃ B T ┃
Length: 10174 (0x27be)
Types: TextFile
Names: »B«
└─⟦25882cbde⟧ Bits:30000536 8mm tape, Rational 1000, RCI_RS6000_AIX_IBM 2_0_2
└─ ⟦b8efda8ac⟧ »DATA«
└─⟦7061b4ee8⟧
└─⟦this⟧
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;