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];
DO
[msg, mExisted]← DeclareMsg[mr.gvID, NewOrOld];
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.