-- Transport Mechanism - Distribution list map program --

-- [Juniper]<Grapevine>User>DLMap>DLMapper.mesa

-- Mike Schroeder, April 12, 1982 1:19 PM --

DIRECTORY BodyDefs, BTreeDefs, crD: FROM "CoreDefs", csD: FROM "CoreStreamDefs", ImageDefs, InlineDefs, IODefs, NameInfoSpecialDefs, NameInfoDefs, PupDefs, StringDefs, TimeDefs, VMDefs;

DLMapper: PROGRAM IMPORTS BTreeDefs, csD, ImageDefs, InlineDefs, IODefs, NameInfoSpecialDefs, NameInfoDefs, PupDefs, StringDefs, TimeDefs, VMDefs =

BEGIN

OPEN IODefs, StringDefs;

DLInfo: TYPE = RECORD [
containedIn : CARDINAL, --number of other groups containing this group--
individuals: CARDINAL, --number of individuals contained in this group--
substructure: CARDINAL --number of contained groups to expand--
];

MyLowerCase: PROCEDURE[c: CHARACTER] RETURNS[CHARACTER] = INLINE
BEGIN
RETURN[IF c IN [’A..’Z] THEN c - ’A + ’a ELSE c];
END; --MyLowerCase--

IsFirstGE: BTreeDefs.TestKeys --[a, b: DESC] RETURNS[BOOLEAN] -- =
BEGIN
aC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
FOR i:CARDINAL IN [0..2*MIN[LENGTH[a],LENGTH[b]]) DO
IF MyLowerCase[aC[i]] < MyLowerCase[bC[i]] THEN RETURN[FALSE];
IF MyLowerCase[aC[i]] > MyLowerCase[bC[i]] THEN RETURN[TRUE];
ENDLOOP;
RETURN[LENGTH[a] >= LENGTH[b]];
END; -- of IsFirstGE --

AreTheyE: BTreeDefs.TestKeys --[a, b: DESC] RETURNS[BOOLEAN] -- =
BEGIN
aC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
IF LENGTH[a] = LENGTH[b] THEN
FOR i:CARDINAL IN [0..2*LENGTH[a]) DO
IF MyLowerCase[aC[i]] # MyLowerCase[bC[i]] THEN EXIT;
REPEAT FINISHED => RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END; -- of AreTheyE --

Run: PROCEDURE =
BEGIN

tree: BTreeDefs.BTreeHandle;
registries: STRING = [64];
utilityString: STRING = [64];
fullStr, conStr: csD.StreamHandle ← NIL;
indention: CARDINAL ← 0;
nameInfoError: SIGNAL = CODE;

GenerateNameInfoError: PROCEDURE[g: STRING] =
BEGIN
WriteChar[CR];
WriteString["NameInfoError on "L];
WriteString[g];
WriteLine[". Can’t proceed."L];
ERROR nameInfoError;
END;

PutBothLines: PROCEDURE [s1:STRING←NIL, s2:STRING←NIL, s3:STRING←NIL,
s4:STRING←NIL, s5:STRING←NIL] =
BEGIN
AddString: PROCEDURE[s: STRING] =
BEGIN
IF s = NIL THEN RETURN;
IF fullStr#NIL THEN csD.WriteBlock[fullStr, @s.text, 0, s.length];
IF conStr#NIL THEN csD.WriteBlock[conStr, @s.text, 0, s.length];
END;
AddString[s1]; AddString[s2]; AddString[s3]; AddString[s4]; AddString[s5];
IF fullStr#NIL THEN csD.Write[fullStr,CR];
IF conStr#NIL THEN csD.Write[conStr,CR];
END; -- PutBothLines --

PutFullLine: PROCEDURE [s1:STRING←NIL, s2:STRING←NIL, s3:STRING←NIL,
s4:STRING←NIL, s5:STRING←NIL] =
BEGIN
AddString: PROCEDURE[s: STRING] =
BEGIN
IF s = NIL THEN RETURN;
IF fullStr#NIL THEN csD.WriteBlock[fullStr, @s.text, 0, s.length];
END;
IF indention # 0 THEN
FOR i:CARDINAL IN [0..indention) DO AddString[". "L]; ENDLOOP;
AddString[s1]; AddString[s2]; AddString[s3]; AddString[s4]; AddString[s5];
IF fullStr#NIL THEN csD.Write[fullStr,CR];
END; -- PutBothLines --

PutConLine: PROCEDURE [s1:STRING←NIL, s2:STRING←NIL, s3:STRING←NIL,
s4:STRING←NIL, s5:STRING←NIL] =
BEGIN
AddString: PROCEDURE[s: STRING] =
BEGIN
IF s = NIL THEN RETURN;
IF conStr#NIL THEN csD.WriteBlock[conStr, @s.text, 0, s.length];
END;
AddString[s1]; AddString[s2]; AddString[s3]; AddString[s4]; AddString[s5];
IF conStr#NIL THEN csD.Write[conStr,CR];
END; -- PutBothLines --

GroupsWork: PROCEDURE [group:BodyDefs.RName]
RETURNS [done: BOOLEAN] =
BEGIN
individuals: CARDINAL ← 0;
substructure: CARDINAL ← 0;
contentInfo: NameInfoDefs.MemberInfo;
IncrementContainedCountInBTree: PROCEDURE [name: BodyDefs.RName] =
BEGIN
entry: DLInfo ← GetEntry[name];
entry.containedIn ← entry.containedIn+1;
PutEntry[name, entry];
END; --IncrementContainedCountInBTree--
AddContentInfoToBTree: PROCEDURE [name: BodyDefs.RName,
individuals: CARDINAL, substructure: CARDINAL] =
BEGIN
entry: DLInfo ← GetEntry[name];
entry.individuals ← individuals;
entry.substructure ← substructure;
PutEntry[name, entry];
WriteLine[name];
END; --AddContentInfoToBTree--
ContentWork: PROCEDURE [member:BodyDefs.RName]
RETURNS [done: BOOLEAN] =
BEGIN
done ← FALSE;
SELECT NameClassification[member] FROM
ind => individuals ← individuals+1;
pGrp =>
{IncrementContainedCountInBTree[member]; substructure ← substructure+1};
ENDCASE => substructure ← substructure+1;
END; --ContentWork--
done ← FALSE;
FOR i: CARDINAL IN [0..group.length) DO
IF group[i] = ’↑ THEN EXIT;
REPEAT FINISHED => RETURN;
ENDLOOP;
contentInfo ← NameInfoDefs.GetMembers[group];
WITH c:contentInfo SELECT FROM
group => BEGIN
NameInfoDefs.Enumerate[c.members, ContentWork];
NameInfoDefs.Close[c.members];
AddContentInfoToBTree[group, individuals, substructure];
END;
notFound => NULL;
ENDCASE => GenerateNameInfoError[group];
END; --GroupsWork--

NameClassification: PROCEDURE[n: STRING] RETURNS[{ind, pGrp, npGrp}] =
BEGIN
memberReg: STRING = [32];
MatchingWork: PROCEDURE[r: STRING] RETURNS[BOOLEAN]
= {RETURN[EquivalentString[memberReg, r]]};
FOR i: CARDINAL IN [0..n.length) DO
IF n[i] = ’↑ THEN BEGIN
FOR j:CARDINAL IN [i+2..n.length) DO AppendChar[memberReg, n[j]]; ENDLOOP;
RETURN [IF ForAllRegistriesDo[MatchingWork] THEN pGrp ELSE npGrp];
END;
ENDLOOP;
RETURN[ind];
END; -- NameClassification --

GetEntry: PROCEDURE[n: BodyDefs.RName] RETURNS [i: DLInfo] =
BEGIN
key: DESCRIPTOR FOR ARRAY OF WORD = DESCRIPTOR [@(n.text), (n.length+1)/2];
value: DESCRIPTOR FOR ARRAY OF WORD = DESCRIPTOR [@(i), SIZE[DLInfo]];
IF n.length MOD 2 # 0 THEN n[n.length] ← ’@;
IF BTreeDefs.Lookup[tree, key, value] = BTreeDefs.KeyNotFound
THEN i ← DLInfo[containedIn:0, individuals:0, substructure: 0];
END; --GetEntry--

PutEntry: PROCEDURE[n: BodyDefs.RName, i: DLInfo] =
BEGIN
key: DESCRIPTOR FOR ARRAY OF WORD = DESCRIPTOR [@(n.text), (n.length+1)/2];
value: DESCRIPTOR FOR ARRAY OF WORD = DESCRIPTOR[@(i), SIZE[DLInfo]];
IF n.length MOD 2 # 0 THEN n[n.length] ← ’@;
BTreeDefs.Insert[tree, key, value];
END; --PutEntry--

AlreadyDoneThis: SIGNAL [new: BodyDefs.RName] RETURNS [BOOLEAN] = CODE;

PrintEntryForName: PROCEDURE[n: BodyDefs.RName, i: DLInfo] =
BEGIN
lm: STRING = ""L; -- tab --
IF (SIGNAL AlreadyDoneThis[n])
THEN PutFullLine[n, " **loop**"L]
ELSE BEGIN
mbrs: STRING = [4];
AppendNumber[mbrs, i.individuals, 10];
IF indention = 0
THEN BEGIN
ExtractRNames: PROCEDURE [l: NameInfoDefs.MemberInfo, s: STRING] =
BEGIN
ExtWork: PROCEDURE[sn:BodyDefs.RName] RETURNS [done:BOOLEAN] =
BEGIN
done ← FALSE;
IF s.length # 0
THEN AppendString[s, ", "L ! StringBoundsFault => CONTINUE ];
AppendString[s, sn ! StringBoundsFault => CONTINUE ];
END; --ExtWork--
utilityString.length ← 0;
WITH g:l SELECT FROM
group => BEGIN
NameInfoDefs.Enumerate[g.members, ExtWork];
NameInfoDefs.Close[g.members];
END;
ENDCASE => GenerateNameInfoError[n];
END; --ExtractRNames--
inDLs: STRING = [4];
WriteString[n];
SELECT NameInfoDefs.GetRemark[n, utilityString] FROM
group => NULL;
notFound => {WriteLine[" - not found."L]; RETURN};
ENDCASE => GenerateNameInfoError[n];
PutBothLines[];
IF utilityString.length = 0
THEN PutBothLines[n]
ELSE PutBothLines[n, " - "L, utilityString];
AppendNumber[inDLs, i.containedIn, 10];
IF i.containedIn # 0
THEN PutFullLine[lm, mbrs, " individuals; in "L, inDLs, " other DL(s)"]
ELSE PutFullLine[lm, mbrs, " individuals"L];
ExtractRNames[NameInfoDefs.GetOwners[n], utilityString];
IF utilityString.length = 0
THEN BEGIN
AppendString[utilityString, "DEFAULT"];
PutFullLine[lm, "Owners: "L, utilityString];
END
ELSE BEGIN
PutFullLine[lm, "Owners: "L, utilityString];
PutConLine[lm, "O: "L, utilityString];
END;
ExtractRNames[NameInfoDefs.GetFriends[n], utilityString];
IF utilityString.length = 0
THEN BEGIN
AppendString[utilityString, "NIL"];
PutFullLine[lm, "Friends: "L, utilityString];
END
ELSE BEGIN
PutFullLine[lm, "Friends: "L, utilityString];
PutConLine[lm, "F: "L, utilityString];
END;
END -- indention = 0 --
ELSE PutFullLine[n, " - "L, mbrs];
IF i.substructure > 0 THEN BEGIN
mi: NameInfoDefs.MemberInfo = NameInfoDefs.GetMembers[n];
indention ← indention + 1;
WITH g:mi SELECT FROM
group =>
BEGIN
SubstructureWork: PROCEDURE[sn:BodyDefs.RName]
RETURNS [done:BOOLEAN] =
BEGIN
done ← FALSE;
FOR j:CARDINAL IN [0..sn.length) DO
IF sn[j] = ’↑ THEN EXIT;
REPEAT FINISHED => RETURN;
ENDLOOP;
IF i.substructure = 1
AND indention = 1
AND i.individuals = 0
AND NameClassification[sn] = pGrp
THEN BEGIN -- contains exactly one other list, also in this listing --
PutFullLine[sn, " - is the only contained group; see that entry."L];
done ← TRUE;
END
ELSE
IF i.individuals = 0 AND NameClassification[sn] = npGrp
THEN PutFullLine[sn, " - not expanded."L]
ELSE PrintEntryForName[sn, GetEntry[sn]];
END; --SubstructureWork--
NameInfoDefs.Enumerate[g.members, SubstructureWork
! AlreadyDoneThis => IF EquivalentString[new, n] THEN RESUME[TRUE]];
NameInfoDefs.Close[g.members];
END;
ENDCASE => GenerateNameInfoError[n];
indention ← indention - 1;
-- IF indention = 0 THEN PutConLine[lm, "Has nested DLs"L];
END;
IF indention = 0 THEN WriteChar[CR];
END;
END; --PrintEntryForName--

PrintingWork: BTreeDefs.Call
--PROCEDURE[k, v: DESCRIPTOR] RETURNS[more, dirty: BOOLEAN]-- =
BEGIN
i: DLInfo;
n: BodyDefs.RName = [BodyDefs.maxRNameLength];
more ← TRUE; dirty ← FALSE;
IF LENGTH[k] = 0 THEN RETURN;
InlineDefs.COPY[from:BASE[v], to:@(i), nwords:LENGTH[v]];
InlineDefs.COPY[from:BASE[k], to:@(n.text), nwords:LENGTH[k]];
n.length ← 2*LENGTH[k];
IF n[n.length-1] = ’@ THEN n.length ← n.length - 1;
PrintEntryForName[n, i ! AlreadyDoneThis => RESUME[FALSE]];
END; --PrintingWork--

EnumerateRegistry: PROCEDURE [reg: BodyDefs.RName] RETURNS[BOOLEAN] =
BEGIN
IF reg.length # 0 THEN BEGIN
nameInfo: NameInfoDefs.MemberInfo;
utilityString.length ← 0;
StringDefs.AppendString[utilityString, "groups."L];
StringDefs.AppendString[utilityString, reg];
nameInfo ← NameInfoDefs.GetMembers[utilityString];
WITH n:nameInfo SELECT FROM
group =>
BEGIN
WriteChar[CR];
WriteString["Enumerating "L];
WriteLine[utilityString];
NameInfoDefs.Enumerate[n.members, GroupsWork];
NameInfoDefs.Close[n.members];
END;
ENDCASE =>
{WriteString[reg]; WriteLine[" not a valid registry."L]; ERROR nameInfoError};
END;
RETURN[FALSE]
END; --EnumerateRegsitry--

WriteHerald: PROCEDURE =
BEGIN
time: STRING = [20];
WriteString["Grapevine Distribution List Mapping Program of "L];
TimeDefs.AppendDayTime[time,TimeDefs.UnpackDT[ImageDefs.BcdTime[]]];
WriteLine[time];
END;

ForAllRegistriesDo: PROCEDURE[Work:PROCEDURE[reg:STRING]
RETURNS[BOOLEAN]] RETURNS[BOOLEAN] =
BEGIN
registry: STRING = [32];
FOR j:CARDINAL IN [0 .. registries.length) DO
IF registries[j] = ’+
THEN {IF Work[registry] THEN RETURN[TRUE]; registry.length ← 0;}
ELSE AppendChar[registry, registries[j]];
ENDLOOP;
RETURN[FALSE];
END; -- ForAllRegistriesDo --

Terminate: PROCEDURE [c: CHARACTER] RETURNS [BOOLEAN] =
{RETURN[SELECT c FROM ESC,SP,CR => TRUE, ENDCASE =>FALSE]};

BEGIN --for EXITS --
VMDefs.InitializeVM [min:4, max:8];
tree ← BTreeDefs.CreateAndInitializeBTree[
fileH:LOOPHOLE[VMDefs.OpenFile[name: "DLMap.btree$", options: oldOrNew]],
initializeFile:TRUE,
useDefaultOrderingRoutines:FALSE,
isFirstGreaterOrEqual:IsFirstGE,
areTheyEqual:AreTheyE];
WriteChar[CR];
WriteHerald[];
WriteString["Full listing (y or *)? "L];
IF LowerCase[ReadChar[]] = ’y THEN
DO
WriteChar[CR];
WriteString["Type output file name for full listing: "L];
utilityString.length ← 0;
AppendString[utilityString, "FullDLMap.txt"L];
ReadString[utilityString, Terminate ! Rubout => LOOP];
IF utilityString.length = 0 THEN GOTO cleanup;
fullStr ← csD.OpenFromName[utilityString,
crD.DMSUser[NIL, NIL, NIL], byte, overwrite, 1
! csD.Error => {WriteString["Can’t open file."L]; LOOP}];
EXIT;
ENDLOOP;
WriteChar[CR];
WriteString["Condensed listing? (y or *) "L];
IF LowerCase[ReadChar[]] = ’y THEN
DO
WriteChar[CR];
WriteString["Type output file name for condensed listing: "L];
utilityString.length ← 0;
AppendString[utilityString, "DLMap.txt"L];
ReadString[utilityString, Terminate ! Rubout => LOOP];
IF utilityString.length = 0 THEN GOTO cleanup;
conStr ← csD.OpenFromName[utilityString,
crD.DMSUser[NIL, NIL, NIL], byte, overwrite, 1
! csD.Error => {WriteString["Can’t open file."L]; LOOP}];
EXIT;
ENDLOOP;
IF fullStr = NIL AND conStr = NIL THEN GOTO cleanup;
DO
WriteChar[CR];
WriteString["Type registry names (separated with ""+""): "L];
ReadID[registries ! Rubout => LOOP];
EXIT;
ENDLOOP;
WriteChar[CR];
utilityString.length ← 0;
TimeDefs.AppendDayTime[utilityString,
TimeDefs.UnpackDT[ TimeDefs.CurrentDayTime[]]];
PutBothLines["Distribution list map of "L, registries, " produced at "L, utilityString];
AppendChar[registries, ’+];
PutConLine[];
PutConLine["""O:"" is ""owners"" access control list for DL."L ];
PutConLine["""F:"" is ""friends"" access control list for DL."L ];
PutConLine[];
[] ← ForAllRegistriesDo[EnumerateRegistry ! nameInfoError => GOTO cleanup];
WriteChar[CR];
WriteLine["Producing output file."];
WriteChar[CR];
PutBothLines[];
BTreeDefs.EnumerateFrom[tree, DESCRIPTOR[NIL, 0], PrintingWork
! nameInfoError => GOTO cleanup;
csD.Error =>
{WriteChar[CR]; WriteLine["Error writing output file."L]; GOTO cleanup}];
PutBothLines[];
PutBothLines["End of listing."L];
GOTO cleanup;
EXITS
cleanup => BEGIN
IF fullStr # NIL THEN csD.Close[fullStr ! csD.Error => CONTINUE];
IF conStr # NIL THEN csD.Close[conStr ! csD.Error => CONTINUE];
NameInfoSpecialDefs.CleanUp[];
VMDefs.AbandonFile[LOOPHOLE[BTreeDefs.ReleaseBTree[tree]]];
VMDefs.FinalizeVM[];
END;
END;
END;

PupDefs.PupPackageMake[];
Run[];
PupDefs.PupPackageDestroy[];

END.