|
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 - metrics - downloadIndex: B T
Length: 11983 (0x2ecf)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Log;
with Cmvc;
with Names;
with Errors;
with Profile;
with Library;
with Operator;
with Directory;
with Work_Order;
with Access_List;
with Object_Info;
with Compilation;
with Debug_Tools;
with Directory_Tools;
with String_Utilities;
with Design_Implementation;
package body Destruction_Utilities is
function Plural (For_Value : in Natural) return String is
begin
if (For_Value = 1) then
return ("");
else
return ("s");
end if;
end Plural;
procedure Destroy_All (Of_These : in String := "<SELECTION>";
Target_Key : in String := "R1000";
Response : in String := "<PROFILE>") is
--
Old_Response_Profile : Profile.Response_Profile := Profile.Get;
New_Response_Profile : Profile.Response_Profile :=
Profile.Value (Response);
--
package Error is
new Errors
(Old_Response_Profile, New_Response_Profile, "Destroy_All");
--
Initial_Objects : Object_Info.Objects :=
Directory_Tools.Naming.Resolution (Of_These);
--
procedure Set_State_Of (This_Object : in Object_Info.Object) is
--
The_Object : constant String :=
Directory_Tools.Naming.Full_Name (This_Object);
--
Directory_Object : Directory.Object;
The_Status : Directory.Error_Status;
--
begin
Access_List.Set (For_Object => The_Object);
Library.Unfreeze (Existing => The_Object, Recursive => False);
Cmvc.Check_In (What_Object => The_Object);
Directory_Tools.Object.Low_Level.Get_Object
(Handle => This_Object,
The_Object => Directory_Object,
Status => The_Status);
Directory.Object_Operations.Set_Controlled
(The_Object => Directory_Object,
Value => False,
Status => The_Status);
Directory.Object_Operations.Set_Slushy
(The_Object => Directory_Object,
Value => False,
Status => The_Status);
if (Object_Info.Any.Is_World (This_Object)) then
Library.Set_Subclass (Existing => The_Object,
To_Subclass => "World");
Design_Implementation.Set_Target
(To_Value => Target_Key, For_World => The_Object);
end if;
end Set_State_Of;
--
procedure Set_State_Of (These_Objects : in out Object_Info.Objects) is
begin
Directory_Tools.Object.Reset (These_Objects);
while (not Directory_Tools.Object.Done (These_Objects)) loop
declare
Current_Object : Object_Info.Object :=
Directory_Tools.Object.Value (These_Objects);
Current_Closure : Object_Info.Objects :=
Object_Info.Any.All_Objects_In
(This_Object => Current_Object,
Transitive => True);
Dummy : Boolean;
begin
Directory_Tools.Object.Add
(Current_Closure, Current_Object, Dummy);
Directory_Tools.Object.Reset (Current_Closure);
while (not Directory_Tools.Object.Done
(Current_Closure)) loop
Set_State_Of (Directory_Tools.Object.Value
(Current_Closure));
Directory_Tools.Object.Next (Current_Closure);
end loop;
end;
Directory_Tools.Object.Next (These_Objects);
end loop;
end Set_State_Of;
--
procedure Report_Results is
--
Remaining : Natural :=
Object_Info.Any.Number_In
(Directory_Tools.Naming.Resolution (Of_These));
--
begin
if (Remaining > 0) then
Error.Report ("Unable to destroy " &
String_Utilities.Strip_Leading
(Natural'Image (Remaining)) &
" object" & Plural (Remaining),
Nested => True);
else
Log.Put_Line
("[end of Destroy_All operation--0 could not be destroyed]",
Profile.Positive_Msg);
end if;
end Report_Results;
--
begin
--
Log.Put_Line ("[Destroy_All (Of_These => """ & Of_These &
", Target_Key => """ & Target_Key &
""", Response => """ & Response & """);]");
if (Object_Info.Any.Number_In (Initial_Objects) = 0) then
Error.Report ("Cannot resolve any objects in """ & Of_These & """",
This_Type => Profile.Warning_Msg,
Nested => True);
else
Operator.Enable_Privileges (Enable => True);
Work_Order.Set_Default_Venture (To_Venture => "<>");
Set_State_Of (Initial_Objects);
Compilation.Destroy (Unit => Of_These,
Threshold => Integer'Last,
Limit => "<ALL_WORLDS>");
Report_Results;
end if;
--
exception
when Error.Propagate =>
raise;
when Error.Quit =>
null;
when others =>
Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name,
This_Type => Profile.Exception_Msg);
--
end Destroy_All;
procedure Destroy_Users (Named : in String := "<SELECTION>";
Target_Key : in String := "R1000";
Response : in String := "<PROFILE>") is
--
Old_Response_Profile : Profile.Response_Profile := Profile.Get;
New_Response_Profile : Profile.Response_Profile :=
Profile.Value (Response);
--
package Error is
new Errors
(Old_Response_Profile, New_Response_Profile, "Destroy_Users");
--
Users : Directory_Tools.Object.Iterator :=
Directory_Tools.Naming.Resolution (Named);
--
Initial_Number_Of_Objects : Natural :=
Object_Info.Any.Number_In (Users);
--
User_Count : Natural := 0;
--
procedure Verify_Name (This_User : in String) is
begin
if ((not Names.Is_Fully_Qualified_Pathname (This_User)) or else
(not (Directory_Tools.
Naming.Prefix (This_User) = "!USERS"))) then
Error.Report ("Invalid user name """ & This_User & """",
Fatal => False,
Nested => True);
end if;
User_Count := User_Count + 1;
end Verify_Name;
--
procedure Destroy_User (This_User : in Directory_Tools.Object.Handle) is
--
The_User_Full : constant String :=
Directory_Tools.Naming.Full_Name (This_User);
--
The_User : constant String :=
Directory_Tools.Naming.Simple_Name (This_User);
--
begin
Verify_Name (The_User_Full);
Operator.Delete_User (User => The_User, Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Groups." & The_User,
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Users." & The_User,
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Error_Logs." & The_User & "_@",
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Search_Lists." & The_User & "_@",
Target_Key => Target_Key,
Response => "<PROFILE>");
Operator.Create_User (User => The_User, Response => "<PROFILE>");
Operator.Delete_User (User => The_User, Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Groups." & The_User,
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Users." & The_User,
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Error_Logs." & The_User & "_@",
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Machine.Search_Lists." & The_User & "_@",
Target_Key => Target_Key,
Response => "<PROFILE>");
Destroy_All (Of_These => "!Users." & The_User,
Target_Key => Target_Key,
Response => "<PROFILE>");
end Destroy_User;
--
procedure Report_Results is
--
Remaining : Natural :=
Object_Info.Any.Number_In
(Directory_Tools.Naming.Resolution (Named));
--
Expected_Number_Of_Leftover_Objects : Natural :=
Initial_Number_Of_Objects - User_Count;
--
Number_Of_Undeleted_Users : Natural :=
Remaining - Expected_Number_Of_Leftover_Objects;
--
begin
if (Number_Of_Undeleted_Users > 0) then
Error.Report ("Unable to destroy " &
String_Utilities.Strip_Leading
(Natural'Image (Number_Of_Undeleted_Users)) &
" user" & Plural (Number_Of_Undeleted_Users),
Nested => True);
else
Log.Put_Line
("[end of Destroy_Users operation--0 could not be destroyed]",
Profile.Positive_Msg);
end if;
end Report_Results;
--
begin
--
Log.Put_Line ("[Destroy_Users (Named => """ & Named &
", Target_Key => """ & Target_Key &
""", Response => """ & Response & """);]");
Operator.Enable_Privileges (Enable => True);
Directory_Tools.Object.Reset (Users);
if (Directory_Tools.Object.Done (Users)) then
Error.Report ("Cannot resolve any users in """ & Named & """",
This_Type => Profile.Warning_Msg,
Nested => True);
else
Directory_Tools.Object.Reset (Users);
while (not Directory_Tools.Object.Done (Users)) loop
begin
Destroy_User (Directory_Tools.Object.Value (Users));
--
exception
when others =>
Error.Report (Error.Nil_Message,
Fatal => False,
Nested => True);
end;
Directory_Tools.Object.Next (Users);
end loop;
Report_Results;
end if;
--
exception
when Error.Propagate =>
raise;
when Error.Quit =>
null;
when others =>
Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name,
This_Type => Profile.Exception_Msg);
--
end Destroy_Users;
end Destruction_Utilities;