WalnutDBImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Contents: implementation for making changes in Walnut's database
this is the monitored access to the database
Willie-Sue, March 20, 1985 9:04:59 am PST
Last Edited by: Willie-Sue, August 21, 1984 2:51:21 pm PDT
Last Edited by: Donahue, July 15, 1983 1:17 pm
DIRECTORY
BasicTime USING [GMT, Now],
DB USING [ BoolType, EntitySet, GMT, IntType, RopeType, TimeType,
DeclareAttribute, DeclareDomain, DeclareEntity, DeclareIndex,
DeclareRelation, DeclareRelship, DestroyEntity, DestroyRelship, DomainSubset,
Eq, GetF, GetP, GetPList, NameOf, NextEntity, NextRelship, Null, RelationSubset,
ReleaseEntitySet, ReleaseRelshipSet, SetP, SetPList, S2V, T2V, V2I, V2T],
IO,
Rope,
WalnutDB,
WalnutVoice USING [MakeInterestEntry, VoiceMoveTo],
WalnutLog USING [MsgRec, MessageRecObject,
currentSegment, msgIDRope,
GenerateNewMsgID, RopeFromLog, TiogaTextFromLog],
WalnutSendOps USING [userRName, simpleUserName, RFC822Date],
WalnutStream USING [MakeLogEntry];
WalnutDBImpl: CEDAR MONITOR
IMPORTS
DB, IO, Rope, BasicTime,
WalnutDB, WalnutLog, WalnutSendOps, WalnutStream, WalnutVoice
EXPORTS WalnutDB =
BEGIN OPEN DB, WalnutDB;
MsgDomain: PUBLIC Domain;
MsgSetDomain: PUBLIC Domain;
activeMsgSet: PUBLIC MsgSet;
deletedMsgSet: PUBLIC MsgSet;
********************************************************
Relations on Msg entities: all have one relship per Msg unless otherwise noted.
msNumInSet: PUBLIC Relation;
msNumInSetOf: PUBLIC Attribute; -- MsgSet
msNumInSetIs: PUBLIC Attribute; -- INT
mDateCode: PUBLIC Relation;
mDateCodeOf: PUBLIC Attribute; -- Msg
mDateCodeIs: PUBLIC Attribute; -- Time
mSubject: PUBLIC Relation;
mSubjectOf: PUBLIC Attribute; -- Msg
mSubjectIs: PUBLIC Attribute; -- string
mCategory: PUBLIC Relation;
mCategoryOf: PUBLIC Attribute; -- Msg
mCategoryIs: PUBLIC Attribute; -- MsgSet
mCategoryDate: PUBLIC Attribute; -- Index on Category & Date
mInReplyTo: PUBLIC Relation;
mInReplyToOf: PUBLIC Attribute; -- Msg
mInReplyToMsg: PUBLIC Attribute; -- Msg
mInReplyToIs: PUBLIC Attribute; -- the string from the msg
mTOCEntry: PUBLIC Relation;
mTOCEntryOf: PUBLIC Attribute; -- Msg
mTOCEntryIs: PUBLIC Attribute; -- string
mLogPos: PUBLIC Relation;
mLogPosOf: PUBLIC Attribute; -- Msg
mPrefixPos: PUBLIC Attribute; -- int
mHeadersPos: PUBLIC Attribute; -- int
mMsgLength: PUBLIC Relation;
mMsgLengthOf: PUBLIC Attribute; -- Msg
mMsgLengthIs: PUBLIC Attribute; -- int
mHasBeenRead: PUBLIC Relation;
mHasBeenReadOf: PUBLIC Attribute; -- Msg
mHasBeenReadIs: PUBLIC Attribute; -- bool
NumInNegative: SIGNAL[msgSet: ROPE] = CODE;
********************************************************
SetUpdatesPendingProc: PROC[BOOL]← DefaultUpdateProc;
********************************************************
each operation here has a parallel operation in WalnutDBLog, which writes an entry
on the current log
the following are exported in WalnutDB
DeclareMsg: PUBLIC ENTRY PROC[mName: ROPE, version: Version← NewOrOld]
RETURNS [msg: Msg, existed: BOOL] =
Creates a new Msg entity (unless version = oldOnly), and sets its name to be mName.
is called when messages have been read from the log or another file.
If the Msg already exists, returns it and existed=TRUE
BEGIN ENABLE UNWIND => NULL;
msg← DeclareEntity[MsgDomain, mName, OldOnly];
IF msg#NIL THEN RETURN[msg, TRUE];
IF version = NewOrOld THEN
{ msg← DeclareEntity[MsgDomain, mName];
SetUpdatesPendingProc[TRUE];
};
RETURN[msg, FALSE]
END;
DeclareMsgSet: PUBLIC ENTRY PROC[msName: ROPE, version: Version← NewOrOld]
RETURNS [msgSet: MsgSet, existed: BOOL] =
Creates a new MsgSet entity (unless version = oldOnly), and sets its name to be mName.
is called when user creates a message set, or a log file is read
If the MsgSet already exists, returns it and existed=TRUE.
BEGIN ENABLE UNWIND => NULL;
msgSet← DeclareEntity[MsgSetDomain, msName, OldOnly];
IF msgSet#NIL THEN RETURN[msgSet, TRUE];
IF version = NewOrOld THEN
{ msgSet← DeclareEntity[MsgSetDomain, msName];
SetUpdatesPendingProc[TRUE];
};
RETURN[msgSet, FALSE];
END;
DestroyMsg is not allowed; this is ONLY done by the Expunge operation
DestroyMsgSet: PUBLIC ENTRY PROC[msgSet: MsgSet] RETURNS[newRelList: LIST OF Relship] =
Destroys the given msgSet, removing any messages from it first
BEGIN ENABLE UNWIND => NULL;
rel, newRel: Relship;
relListEnd: LIST OF Relship;
rs: RelshipSet← RelationSubset[mCategory, LIST[[mCategoryIs, msgSet]]];
UNTIL DB.Null[rel← NextRelship[rs]] DO
msg: Msg← V2E[GetF[rel, mCategoryOf]];
IF (newRel← RemoveFrom[msg, msgSet, rel]) # NIL THEN
IF relListEnd=NIL THEN newRelList← relListEnd← CONS[newRel, NIL]
ELSE relListEnd.rest← relListEnd← CONS[newRel, NIL];
ENDLOOP;
ReleaseRelshipSet[rs];
IF ~EqEntities[msgSet, activeMsgSet] THEN DestroyEntity[msgSet];
SetUpdatesPendingProc[TRUE];
END;
AddMsgToMsgSet: PUBLIC ENTRY PROC[msg: Msg, msgSet: MsgSet]
RETURNS[rel: Relship, existed: BOOL] =
Adds Msg to MsgSet, if it's not already in it
IF msgSet=deletedMsgSet, does nothing & returns rel=NIL, existed=FALSE
{ ENABLE UNWIND => NULL;
IF Eq[msgSet, deletedMsgSet] THEN RETURN[NIL, FALSE]; -- can't AddTo "Deleted"
[rel, existed]← AddTo[msg, msgSet]
};
RemoveMsgFromMsgSet: PUBLIC ENTRY PROC[msg: Msg, msgSet: MsgSet, rel: Relship← NIL]
RETURNS[newRel: Relship] =
rel can be NIL, in which case it is found from the database
IF removing msg from msgSet would leave it in no MsgSet, then msg gets added to
the distinguished MsgSet Deleted, and returns that new Relship
does nothing if this Relship doesn't exist (no ERROR generated)
{ ENABLE UNWIND => NULL; RETURN[RemoveFrom[msg, msgSet, rel]]};
SetMsgHasBeenRead: PUBLIC ENTRY PROC[msg: Msg] =
sets the mHasBeenReadIs attribute for msg to TRUE (no check on old value)
BEGIN ENABLE UNWIND => NULL;
[]← SetP[msg, mHasBeenReadIs, B2V[TRUE]];
SetUpdatesPendingProc[TRUE];
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
declare and initialize Walnut's data schema
InitializeDBVars: PUBLIC ENTRY PROC =
BEGIN ENABLE UNWIND => NULL;
MsgDomain←
DeclareDomain[name: "Msg", segment: WalnutLog.currentSegment, estRelships: 10];
MsgSetDomain← DeclareDomain["MsgSet", WalnutLog.currentSegment];
msNumInSet← DeclareRelation["msNumInSet", WalnutLog.currentSegment];
msNumInSetOf← DeclareAttribute[msNumInSet, "of", MsgSetDomain, Key]; -- MsgSet
msNumInSetIs← DeclareAttribute[msNumInSet, "is", IntType]; -- INT
mDateCode← DeclareRelation["mDateCode", WalnutLog.currentSegment];
mDateCodeOf← DeclareAttribute[mDateCode, "of", MsgDomain, Key]; -- Msg
mDateCodeIs← DeclareAttribute[mDateCode, "is", TimeType]; -- Time:
[]← DeclareIndex[mDateCode, LIST[mDateCodeIs], NewOrOld];
mSubject← DeclareRelation["mSubject", WalnutLog.currentSegment];
mSubjectOf← DeclareAttribute[mSubject, "of", MsgDomain, Key]; -- Msg
mSubjectIs← DeclareAttribute[mSubject, "is", RopeType]; -- string
mCategory← DeclareRelation["mCategory", WalnutLog.currentSegment];
mCategoryOf← DeclareAttribute[mCategory, "of", MsgDomain]; -- Msg
mCategoryIs← DeclareAttribute[mCategory, "is", MsgSetDomain --, link: FALSE --]; -- MsgSet
mCategoryDate← DeclareAttribute[mCategory, "date", TimeType]; -- Time
[]← DeclareIndex[mCategory, LIST[mCategoryIs, mCategoryDate], NewOrOld];
mInReplyTo← DeclareRelation["mInReplyTo", WalnutLog.currentSegment];
mInReplyToOf← DeclareAttribute[mInReplyTo, "of", MsgDomain, OptionalKey]; -- Msg
mInReplyToIs← DeclareAttribute[mInReplyTo, "is", RopeType]; -- Msg
mTOCEntry← DeclareRelation["mTOCEntry", WalnutLog.currentSegment];
mTOCEntryOf← DeclareAttribute[mTOCEntry, "of", MsgDomain, Key]; -- Msg
mTOCEntryIs← DeclareAttribute[mTOCEntry, "is", RopeType]; -- string
mLogPos← DeclareRelation["mLogPos", WalnutLog.currentSegment];
mLogPosOf← DeclareAttribute[mLogPos, "of", MsgDomain, Key]; -- Msg
mPrefixPos← DeclareAttribute[mLogPos, "prefix", IntType]; -- int
mHeadersPos← DeclareAttribute[mLogPos, "headers", IntType]; -- int
mMsgLength← DeclareRelation["mMsgLength", WalnutLog.currentSegment];
mMsgLengthOf← DeclareAttribute[mMsgLength, "of", MsgDomain, Key]; -- Msg
mMsgLengthIs← DeclareAttribute[mMsgLength, "length", IntType]; -- int
mHasBeenRead← DeclareRelation["mHasBeenRead", WalnutLog.currentSegment];
mHasBeenReadOf← DeclareAttribute[mHasBeenRead, "of", MsgDomain, Key]; -- Msg
mHasBeenReadIs← DeclareAttribute[mHasBeenRead, "is", BoolType]; -- bool
activeMsgSet← DeclareEntity[MsgSetDomain, "Active"];  -- NewOrOld
deletedMsgSet← DeclareEntity[MsgSetDomain, "Deleted"];
END;
TiogaMsgFromLog: PUBLIC PROC[msg: Msg]
RETURNS[contents: TiogaContents, startPos, length: INT] =
reads tioga text for msg from log
BEGIN
startPos← V2I[GetP[msg, mHeadersPos]];
length← V2I[GetP[msg, mMsgLengthIs]];
contents← WalnutLog.TiogaTextFromLog[startPos, length];
END;
NumInMsgSet: PUBLIC ENTRY PROC[msgSet: MsgSet] RETURNS[INT] =
{ ENABLE UNWIND => NULL; RETURN[V2I[GetP[msgSet, msNumInSetIs]]] };
ArchiveMsgSet: PUBLIC ENTRY PROC[msgSet: MsgSet, strm: IO.STREAM, doDelete: BOOL]
RETURNS[newRelList: LIST OF Relship] =
needs to be entirely inside the DB monitor
if doDelete is TRUE, relturns list of newRels for msgs added to Deleted
BEGIN ENABLE UNWIND => NULL;
rel, newRel: Relship;
endRL: LIST OF Relship← NIL;
rs: RelshipSet← RelationSubset[mCategory, LIST[[mCategoryIs, msgSet]]];
restOfPrefix: ROPE← Rope.Cat["\nCategories: ", DB.NameOf[msgSet], "\n"];
UNTIL DB.Null[rel← NextRelship[rs]] DO
msg: Msg← V2E[GetF[rel, mCategoryOf]];
startPos: INT← V2I[GetP[msg, mHeadersPos]];
length: INT← V2I[GetP[msg, mMsgLengthIs]];
fullText: ROPE← WalnutLog.RopeFromLog[startPos, length];
prefix: ROPE← Rope.Cat[WalnutLog.msgIDRope, ": ", DB.NameOf[msg], restOfPrefix];
[]← WalnutStream.MakeLogEntry[strm, message, fullText, prefix];
IF doDelete THEN
{ newRel← RemoveFrom[msg, msgSet, rel];
IF newRelList = NIL THEN newRelList← endRL← CONS[newRel, NIL]
ELSE endRL← endRL.rest← CONS[newRel, NIL];
};
ENDLOOP;
ReleaseRelshipSet[rs];
END;
NameToEntity: PUBLIC ENTRY PROC[d: Domain, name: ROPE, version: Version]
RETURNS[e: Entity] =
BEGIN ENABLE UNWIND => NULL;
e← DeclareEntity[d, name, OldOnly];
IF e=NIL AND version=NewOrOld THEN e← DeclareEntity[d, name, NewOnly];
END;
GetEntitiesInDomain: PUBLIC ENTRY PROC[d: Domain, alphaOrder: BOOL]
RETURNS[eL: LIST OF Entity] =
returns list of entities in given domain
BEGIN ENABLE UNWIND => NULL;
eLend: LIST OF Entity;
es: EntitySet← IF alphaOrder THEN DomainSubset[d, NIL, "", "\177"] ELSE DomainSubset[d];
e: Entity← NextEntity[es];
IF e=NIL THEN RETURN[NIL];
eL← eLend← CONS[e, NIL];
UNTIL DB.Null[e← NextEntity[es]] DO eLend← eLend.rest← CONS[e, NIL]; ENDLOOP;
ReleaseEntitySet[es];
END;
RelationSubsetList: PUBLIC ENTRY PROC[r: Relation, constraint: AttributeValueList← NIL]
RETURNS[relList: LIST OF Relship] =
BEGIN ENABLE UNWIND => NULL;
rs: RelshipSet← RelationSubset[r, constraint];
rel: Relship← NextRelship[rs];
rLend: LIST OF Relship;
IF rel = NIL THEN RETURN;
relList← rLend← CONS[rel, NIL];
UNTIL DB.Null[rel← NextRelship[rs]] DO rLend← rLend.rest← CONS[rel, NIL]; ENDLOOP;
ReleaseRelshipSet[rs];
END;
GetFE: PUBLIC ENTRY PROC[rel: Relship, a: Attribute] RETURNS [Entity] =
{ ENABLE UNWIND => NULL; RETURN[V2E[DB.GetF[rel, a]]] };
GetName: PUBLIC ENTRY PROC[e: Entity] RETURNS [ROPE] =
{ ENABLE UNWIND => NULL; RETURN[DB.NameOf[e]] };
Null: PUBLIC ENTRY PROC[e: Entity] RETURNS [BOOL] =
{ ENABLE UNWIND => NULL; RETURN[DB.Null[e]] };
MGetP: PUBLIC ENTRY PROC[m: Msg, prop: Attribute] RETURNS [Value] =
Finds the one unique value for prop for m or NIL if none.
SIGNALs NonUniquePropertyValue if more than one value.
{ ENABLE UNWIND => NULL; RETURN[DB.GetP[m, prop]] };
MSetPList: PUBLIC ENTRY PROC[m: Msg, prop: Attribute, vl: LIST OF Value] =
Sets the values of prop for m to be those in vl.
Erases any previous property values.
BEGIN ENABLE UNWIND => NULL;
DB.SetPList[m, prop, vl];
SetUpdatesPendingProc[TRUE];
END;
MSetP: PUBLIC ENTRY PROC[m: Msg, prop: Attribute, v: Value] RETURNS [rel: Relship] =
Sets the value of prop for m to be v.
Erases any previous property value(s).
Returns the relship used by the prop.
BEGIN ENABLE UNWIND => NULL;
rel← DB.SetP[m, prop, v];
SetUpdatesPendingProc[TRUE];
END;
AcquireDBLock: PUBLIC ENTRY PROC[procToCall: PROC] =
to allow extended use of lock on database
BEGIN ENABLE UNWIND => NULL;
procToCall[];
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
RegisterUpdatesPendingProc: PUBLIC ENTRY PROC[proc: PROC[BOOL]] =
{ ENABLE UNWIND => NULL; SetUpdatesPendingProc← proc};
UnRegisterUpdatesPendingProc: PUBLIC ENTRY PROC[proc: PROC[BOOL]] =
{ ENABLE UNWIND => NULL;
IF SetUpdatesPendingProc = proc THEN SetUpdatesPendingProc← DefaultUpdateProc
};
DefaultUpdateProc: PROC[BOOL] = { NULL };
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
MsgRecToMsg: PUBLIC PROC[mr: WalnutLog.MsgRec]
RETURNS[msg: Msg, mExisted: BOOL,
newMsgSetList: LIST OF MsgSet, newRelList: LIST OF RelshipMsgSetPair] =
Converts msg from record to entity form
BEGIN
CategoryRelshipList: PROC[msgSetName: ROPE] =
BEGIN
msgSet: MsgSet;
msExisted, rExisted: BOOL;
rel: Relship;
[msgSet, msExisted]← DeclareMsgSet[msgSetName, NewOrOld];
IF ~msExisted THEN newMsgSetList← CONS[msgSet, newMsgSetList];
[rel, rExisted]← AddToMsgSet[msg, msgSet];
IF ~rExisted THEN newRelList← CONS[[rel, msgSet], newRelList];
END;
DO
[msg, mExisted]← DeclareMsg[mr.gvID, NewOrOld];
IF ~mExisted THEN
BEGIN
make up TOC entry
pos: INT← mr.gvID.Find["$"]+1;  -- $ is not allowed in names, so it's unique
date: ROPE← GetTocDate[mr];
toc: ROPE← IF mr.from.Equal[WalnutSendOps.userRName, FALSE] OR
mr.from.Equal[WalnutSendOps.simpleUserName, FALSE]
THEN Rope.Concat["To: ", mr.to]
ELSE mr.from;
mr.tocEntry← Rope.Cat[date, " ", toc];
SetMsgAttributes[msg, mr];
IF mr.voiceID.Length[] # 0 THEN WalnutVoice.MakeInterestEntry[mr.voiceID, mr.gvID];
IF mr.categoriesList = NIL THEN CategoryRelshipList["Active"] -- add to msgSets
ELSE
FOR cL: LIST OF ROPE← mr.categoriesList, cL.rest UNTIL cL = NIL DO
CategoryRelshipList[cL.first] ENDLOOP;
RETURN
END  -- new msg
ELSE
BEGIN
check if this really is an old msg - only check msgLength & subject fields
len: INT← V2I[GetP[msg, mMsgLengthIs]];
subj: ROPE;
IF len # mr.msgLength THEN { WalnutLog.GenerateNewMsgID[mr]; LOOP};
subj← V2S[GetP[msg, mSubjectIs]];
IF ~Rope.Equal[subj, mr.subject] THEN { WalnutLog.GenerateNewMsgID[mr]; LOOP};
RETURN;  -- old msg
END;
ENDLOOP;  -- in case need to change mr.gvID
END;
GetTocDate: PROC[mr: WalnutLog.MsgRec] RETURNS[date: ROPE] =
BEGIN
tyme: BasicTime.GMT;
IF mr.date = NIL THEN mr.date← WalnutSendOps.RFC822Date[];
BEGIN  -- get date into canonical form
ris: IO.STREAM← IO.RIS[mr.date];
tyme← IO.GetTime[ris ! IO.Error => GOTO badTime];
EXITS
badTime => tyme← BasicTime.Now[];
END;
date← Rope.Substr[WalnutSendOps.RFC822Date[tyme], 0, 9]; -- only want first 9 chars of date
DO
i: INT← date.Find["-"];
IF i < 0 THEN RETURN;
date← date.Replace[i, 1, " "];
ENDLOOP;
END;
AddToMsgSet: ENTRY PROC[msg: Msg, msgSet: MsgSet] RETURNS[rel: Relship, existed: BOOL] =
{ ENABLE UNWIND => NULL;
[rel, existed]← AddTo[msg, msgSet]
};
SetMsgAttributes: ENTRY PROC[msg: Msg, mr: WalnutLog.MsgRec] =
BEGIN ENABLE UNWIND => NULL;
[]← SetP[msg, mDateCodeIs, T2V[LOOPHOLE[mr.dateCode, DB.GMT]]];
[]← SetP[msg, mInReplyToIs, S2V[mr.inReplyTo]];
[]← SetP[msg, mHasBeenReadIs, B2V[mr.hasBeenRead]];
[]← SetP[msg, mTOCEntryIs, S2V[mr.tocEntry]];
[]← SetP[msg, mSubjectIs, S2V[mr.subject]];
[]← SetP[msg, mPrefixPos, I2V[mr.prefixPos]];
[]← SetP[msg, mMsgLengthIs, I2V[mr.msgLength]];
[]← SetP[msg, mHeadersPos, I2V[mr.headersPos]];
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
AddTo: INTERNAL PROC[msg: Msg, msgSet: MsgSet] RETURNS[rel: Relship, existed: BOOL] =
BEGIN
avl: AttributeValueList;
IF ~EqEntities[msgSet, deletedMsgSet] THEN
{ avl← LIST[[mCategoryOf, msg], [mCategoryIs, deletedMsgSet],
[mCategoryDate, GetP[msg, mDateCodeIs]]];
rel← DeclareRelship[mCategory, avl, OldOnly];
IF rel # NIL THEN -- msg is in Deleted, must remove it
{ DestroyRelship[rel]; ChangeNumInSet[deletedMsgSet, -1]};
};
avl← LIST[[mCategoryOf, msg], [mCategoryIs, msgSet],
[mCategoryDate, GetP[msg, mDateCodeIs]]];
rel← DeclareRelship[mCategory, avl, OldOnly];
IF existed← (rel # NIL) THEN RETURN;  -- msg is already in this msgSet
rel← DeclareRelship[mCategory, avl, NewOnly];
ChangeNumInSet[msgSet, 1];
SetUpdatesPendingProc[TRUE];
WalnutVoice.VoiceMoveTo[DB.NameOf[msgSet], DB.NameOf[msg]];
END;
RemoveFrom: INTERNAL PROC[msg: Msg, msgSet: MsgSet, rel: Relship]
RETURNS[newRel: Relship] =
rel can be NIL, in which case it is found from the database
does nothing if this Relship doesn't exist (no ERROR generated)
BEGIN
IF rel = NIL THEN
{ rs: RelshipSet← RelationSubset[mCategory, LIST[[mCategoryOf, msg]]];
UNTIL DB.Null[rel← NextRelship[rs]] DO
IF Eq[msgSet, V2E[GetF[rel, mCategoryIs]]] THEN EXIT;
ENDLOOP;
ReleaseRelshipSet[rs];
};
IF rel = NIL THEN RETURN;  -- ignore this call
DestroyRelship[rel];  -- MEraseP[msg, mCategoryIs, msgSet];
ChangeNumInSet[msgSet, -1];
IF GetPList[msg, mCategoryIs] = NIL THEN newRel← AddTo[msg, deletedMsgSet].rel;
SetUpdatesPendingProc[TRUE];
END;
ChangeNumInSet: INTERNAL PROC[msgSet: MsgSet, inc: INT] = INLINE
BEGIN
num: INT← V2I[GetP[msgSet, msNumInSetIs]] + inc;
IF (inc < 0) AND (num = -1) THEN SIGNAL NumInNegative[DB.NameOf[msgSet]];
[]← SetP[msgSet, msNumInSetIs, I2V[num]];
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
debugging procs
notExist: ROPE = "MsgSet: %g doesn't exist";
msNumIn: ROPE = "msNumInSetIs for MsgSet: %g is %g messages";
enumNumIn: ROPE = "Enumeration of MsgSet: %g says %g messages";
NumIn: PROC[msName: ROPE] RETURNS[ans: ROPE] =
BEGIN
msgSet: MsgSet← DeclareEntity[MsgSetDomain, msName, OldOnly];
num: INT;
IF msgSet = NIL THEN RETURN[IO.PutFR[notExist, IO.rope[msName]]];
num← V2I[GetP[msgSet, msNumInSetIs]];
RETURN[IO.PutFR[msNumIn, IO.rope[msName], IO.int[num]]];
END;
Enum: PROC[msName: ROPE] RETURNS[ans: ROPE] =
BEGIN
msgSet: MsgSet← DeclareEntity[MsgSetDomain, msName, OldOnly];
num: INT← 0;
rel: Relship;
rs: RelshipSet;
IF msgSet = NIL THEN RETURN[IO.PutFR[notExist, IO.rope[msName]]];
rs← RelationSubset[mCategory, LIST[[mCategoryIs, msgSet]]];
UNTIL DB.Null[rel← NextRelship[rs]] DO num← num + 1; ENDLOOP;
ReleaseRelshipSet[rs];
RETURN[IO.PutFR[enumNumIn, IO.rope[msName], IO.int[num]]];
END;
SetNumIn: PROC[msName: ROPE, num: INT] RETURNS[ans: ROPE] =
BEGIN
msgSet: MsgSet← DeclareEntity[MsgSetDomain, msName, OldOnly];
IF msgSet = NIL THEN RETURN[IO.PutFR[notExist, IO.rope[msName]]];
[]← SetP[msgSet, msNumInSetIs, I2V[num]];
RETURN[IO.PutFR["msNumInSetIs for MsgSet: %g has been set to %g",
IO.rope[msName], IO.int[num]]];
END;
CheckAll: PROC RETURNS[ans: ROPE] =
BEGIN
rs: RelshipSet;
rel: Relship;
num, enum: INT;
msgSet: Entity;
eL: LIST OF Entity← GetEntitiesInDomain[d: MsgSetDomain, alphaOrder: TRUE];
FOR elT: LIST OF Entity← eL, elT.rest UNTIL elT=NIL DO
msgSet← elT.first;
num← V2I[GetP[msgSet, msNumInSetIs]];
enum← 0;
rs← RelationSubset[mCategory, LIST[[mCategoryIs, msgSet]]];
UNTIL DB.Null[rel← NextRelship[rs]] DO enum← enum + 1; ENDLOOP;
ReleaseRelshipSet[rs];
IF num # enum THEN ans← Rope.Cat[ans, " ", DB.NameOf[msgSet]];
ENDLOOP;
IF ans.Length[] = 0 THEN RETURN["All msgsets are ok"];
END;
DateCode: PROC[mName: ROPE] RETURNS[ans: ROPE] =
BEGIN
msg: Msg← DeclareEntity[MsgDomain, mName, OldOnly];
date: BasicTime.GMT← V2T[GetP[msg, mDateCodeIs]];
dr: ROPE← WalnutSendOps.RFC822Date[date];
IF msg = NIL THEN RETURN[IO.PutFR["Msg: %g doesn't exist", IO.rope[mName]]];
date← V2T[GetP[msg, mDateCodeIs]];
RETURN[IO.PutFR["Msg: %g has DateCode: %g", IO.rope[mName], IO.rope[dr]]];
END;
GetMsgAttributes: PROC[name: ROPE] RETURNS[mr: WalnutLog.MsgRec] =
BEGIN
msg: Msg← DeclareEntity[MsgDomain, name, OldOnly];
IF DB.Null[msg] THEN RETURN[NIL];
mr← NEW[WalnutLog.MessageRecObject];
mr.dateCode← V2T[GetP[msg, mDateCodeIs]];
mr.inReplyTo← V2S[GetP[msg, mInReplyToIs]];
mr.hasBeenRead← V2B[GetP[msg, mHasBeenReadIs]];
mr.tocEntry← V2S[GetP[msg, mTOCEntryIs]];
mr.subject← V2S[GetP[msg, mSubjectIs]];
mr.prefixPos← V2I[GetP[msg, mPrefixPos]];
mr.msgLength← V2I[GetP[msg, mMsgLengthIs]];
mr.headersPos← V2I[GetP[msg, mHeadersPos]];
END;
END.