DIRECTORY
DB,
FS USING [StreamOpen],
IO USING [BreakProc, Close, GetChar, GetInt, GetTokenRope, IDProc, int, Put, PutChar, PutRope, RIS, RopeFromROS, ROS, SkipWhitespace, STREAM],
Process USING[Detach, Pause, SecondsToTicks],
Rope USING [Cat, Equal, Fetch, Length, ROPE],
SymTab USING [Create, Fetch, Insert, Ref, Store],
UserProfile USING [Token],
WalnutSortDB,
WalnutSortMail USING [Error];

WalnutSortDBImpl: CEDAR MONITOR
IMPORTS DB, FS, IO, Process, Rope, SymTab, UserProfile, WalnutSortMail
EXPORTS WalnutSortDB
= BEGIN
OPEN WalnutSortDB;

ROPE: TYPE ~ Rope.ROPE;

wsdSegment: DB.Segment ~ $WalnutSortDef;

trigger: DB.Relation;

kwDomain: DB.Domain;

kwDomainProc: PROC[] RETURNS[type: DB.TypeCode] ~ { type _ DB.TypeForDomain[kwDomain] };

kwType: DB.TypeSpec = [ indirect[ kwDomainProc ] ];

trgKwAttribute: CARDINAL = 0;
trgMSAttribute: CARDINAL = 1;
trgPrAttribute: CARDINAL = 2;

triggerRelationType: DB.FieldSpec = DB.L2FS[LIST[[name: "keyword", type: kwType, lengthHint: 50], [name: "msgSet", type: DB.String, lengthHint: 50], [name: "priority", type: DB.Integer]]];

triggerIndex: DB.Index;

open: BOOLEAN _ FALSE;

activity: BOOL _ FALSE;

transOpened: CONDITION;

transaction: DB.TransactionHandle;

cachedTriggerSet: TriggerSet _ NIL;
cacheValid: BOOLEAN _ FALSE;

WatchDBActivity: PROC[] = {
WHILE TRUE DO
Process.Pause[Process.SecondsToTicks[3*60]];
CheckConnection[]
ENDLOOP
 };

CheckConnection: ENTRY PROC[] = {
ENABLE UNWIND => NULL;
IF NOT activity THEN {
CloseInternal[];
WAIT transOpened };
activity _ FALSE };
DeclareSegment: PUBLIC ENTRY PROC [user: ROPE] ~ {
ENABLE UNWIND => NULL;
DB.Initialize[];
CloseInternal[];
DB.DeclareSegment[
filePath: UserProfile.Token [
key: "WalnutSort.SegmentFile",
default: Rope.Cat["[", UserProfile.Token["Alpine.Server", "Luther"], ".Alpine]<", user, ">WalnutSort.Segment"]],
segment: wsdSegment];
cacheValid _ FALSE;
CarefullyApply[OpenInternal] };
CarefullyApply: INTERNAL PROC [action: PROC] ~ {
errorMsg: ROPE _ NIL;
{
count: INT _ 5;  --Try twice for most errors, but five times for DB.Failure
activity _ TRUE;
WHILE count > 0 DO {
OpenInternal[];
action[ !
DB.Aborted => IF count#1 THEN GOTO OneRetry ELSE GOTO SignalAborted;
DB.Error => GOTO SignalError;
DB.Failure => { errorMsg _ info; GOTO SignalFailure };
];
EXIT
EXITS
OneRetry => {
DB.AbortTransaction[transaction ! DB.Failure, DB.Error => CONTINUE];
open _ FALSE; transaction _ NIL;
count _ MIN[count, 2] - 1;
};
SignalError => {
ERROR WalnutSortMail.Error["Database failure: caught DB.Error after two retries"];
};
SignalAborted => {
ERROR WalnutSortMail.Error["Database failure: caught DB.Aborted after two retries"];
};
SignalFailure => {
ERROR WalnutSortMail.Error[Rope.Cat["Database failure: caught DB.Failure after five retries, info: ", errorMsg]];
};
} ENDLOOP;
};
};

ResetSchema: PROC[] ~ {
kwDomain _ DB.DeclareDomain["keyword", wsdSegment];
trigger _ DB.DeclareRelation["trigger", wsdSegment, triggerRelationType];
triggerIndex _ DB.DeclareIndex[trigger, DB.L2F[LIST[trgPrAttribute, trgKwAttribute]]]
};
OpenInternal: INTERNAL PROC ~ {	--Should only be called from under CarefullyApply
schemaInvalid: BOOL _ TRUE;
IF open THEN RETURN;
[transaction, schemaInvalid] _ DB.OpenTransaction[wsdSegment ! DB.Error => IF code=TransactionAlreadyOpen THEN CONTINUE ELSE REJECT];
IF schemaInvalid THEN ResetSchema[];
open _ TRUE;
NOTIFY transOpened };

MarkInternal: INTERNAL PROC ~ {
cacheValid _ FALSE;
DB.MarkTransaction[transaction]
};

CloseInternal: INTERNAL PROC ~ {
IF ~open THEN RETURN;
DB.CloseTransaction[transaction ! DB.Error, DB.Failure, DB.Aborted => CONTINUE];
open _ FALSE; transaction _ NIL
};

Close: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => NULL;
CloseInternal[];
};
GetTriggerSetFromDB: PUBLIC ENTRY PROC RETURNS [t: TriggerSet] ~ {
ENABLE UNWIND => NULL;
MakeTriggerSetNil: PROC ~ {
cachedTriggerSet _ NIL;
cacheValid _ FALSE;
t _ NIL;
};
GetTriggerSetFromDBInternal: INTERNAL PROC ~ {
rSet: DB.RelshipSet ~ DB.RelationSubset[r: trigger, index: triggerIndex, constraint: NIL];
r: DB.Relship;
t _ NEW[TriggerSetRep _ [mapping: SymTab.Create[], clientData: NIL]];
UNTIL (r _ DB.NextRelship[rSet])=NIL DO
key: ROPE ~ DB.EntityInfo[DB.V2E[DB.GetF[r, trgKwAttribute]]].name;
msName: ROPE ~ DB.V2S[DB.GetF[r, trgMSAttribute]];
priority: INT ~ DB.V2I[DB.GetF[r, trgPrAttribute]];
IF NOT SymTab.Insert[x: t.mapping, key: key, val: NEW[Trigger _ [LIST[msName], priority]]] THEN {
trig: REF Trigger _ NARROW[SymTab.Fetch[t.mapping, key].val];
SELECT TRUE FROM
trig.priority = priority => trig.msNames _ CONS[msName, trig.msNames];
trig.priority < priority => [] _ SymTab.Store[x: t.mapping, key: key,
val: NEW[Trigger _ [LIST[msName], priority]]];
ENDCASE => NULL; -- ignore items of lower priority than what we have already
};
ENDLOOP;
DB.ReleaseRelshipSet[rSet];
cachedTriggerSet _ t; cacheValid _ TRUE;
CloseInternal[] };

IF cacheValid THEN RETURN [cachedTriggerSet];
CarefullyApply[GetTriggerSetFromDBInternal ! WalnutSortMail.Error => MakeTriggerSetNil[]];
};
AddTriggerInternal: INTERNAL PROC [msName, keyword: ROPE, priority: INTEGER _ 10] ~ {
AddTriggerInternalInternal: INTERNAL PROC ~ {
kw: DB.Entity ~ DB.DeclareEntity[kwDomain, keyword];
setForKw: DB.RelshipSet ~ DB.RelshipsWithEntityField[trigger, trgKwAttribute, kw];
FOR next: DB.Relship _ DB.NextRelship[setForKw], DB.NextRelship[setForKw] UNTIL next = NIL DO
IF Rope.Equal[msName, DB.V2S[DB.GetF[next, trgMSAttribute]]] THEN {
DB.SetF[next, trgPrAttribute, DB.I2V[priority]];
DB.ReleaseRelshipSet[setForKw];
RETURN }
ENDLOOP;
DB.ReleaseRelshipSet[setForKw];
[] _ DB.CreateRelship[trigger, DB.L2VS[LIST[DB.E2V[kw], DB.S2V[msName], DB.I2V[priority]]]];
};
CarefullyApply[AddTriggerInternalInternal];
};
AddTrigger: PUBLIC ENTRY PROC [msName, keyword: ROPE, priority: CARDINAL _ 10] ~ {
ENABLE UNWIND => NULL;
AddTriggerInternalInternal: INTERNAL PROC ~ {
AddTriggerInternal[msName, keyword, priority];
MarkInternal[] };
CarefullyApply[AddTriggerInternalInternal];
};
DeleteTrigger: PUBLIC ENTRY PROC [msName, keyword: ROPE] ~ {
ENABLE UNWIND => NULL;
DeleteTriggerInternal: INTERNAL PROC ~ {
kw: DB.Entity ~ DB.LookupEntity[kwDomain, keyword];
IF kw = NIL THEN RETURN;
BEGIN
setForKw: DB.RelshipSet ~ DB.RelshipsWithEntityField[trigger, trgKwAttribute, kw];
relshipToDestroy: DB.Relship;
FOR next: DB.Relship _ DB.NextRelship[setForKw], DB.NextRelship[setForKw] UNTIL next = NIL DO
IF Rope.Equal[msName, DB.V2S[DB.GetF[next, trgMSAttribute]]] THEN
{ relshipToDestroy _ next; RETURN }
ENDLOOP;
DB.ReleaseRelshipSet[setForKw];
IF relshipToDestroy = NIL THEN RETURN;
DB.DestroyRelship[relshipToDestroy];
DB.MarkTransaction[transaction]
END };
CarefullyApply[DeleteTriggerInternal];
};
DumpToStream: PUBLIC ENTRY PROC [s: IO.STREAM] ~ {
ENABLE UNWIND => NULL;
DumpToStreamInternal: INTERNAL PROC ~ {
OpenInternal[];
{
rels: DB.RelshipSet ~ DB.RelationSubset[r: trigger, index: triggerIndex, constraint: NIL];
rel: DB.Relship;
WHILE (rel _ DB.NextRelship[rels]) # NIL DO
keyword: ROPE ~ DB.EntityInfo[DB.V2E[DB.GetF[rel, trgKwAttribute]]].name;
IO.Put[s, IO.int[DB.V2I[DB.GetF[rel, trgPrAttribute]]]];
IO.PutChar[s, '\t];
IO.PutRope[s, DB.V2S[DB.GetF[rel, trgMSAttribute]]];
IO.PutChar[s, '\t];
FOR index: INT IN [0 .. Rope.Length[keyword]) DO
PutEncodedChar[s, Rope.Fetch[base: keyword, index: index]];
ENDLOOP;
IO.PutChar[s, '\n];
ENDLOOP;
DB.ReleaseRelshipSet[rels]
};
CloseInternal[];
};
CarefullyApply[DumpToStreamInternal];
};
DumpToFile: PUBLIC PROC [fileName: ROPE] ~ {
s: IO.STREAM _ FS.StreamOpen[
fileName: fileName,
accessOptions: create
];
DumpToStream[s];
IO.Close[s];
};
LoadFromStream: PUBLIC ENTRY PROC [s: IO.STREAM] ~ {
ENABLE UNWIND => NULL;
LoadFromStreamInternal: INTERNAL PROC ~ {
msgSet, keyword: ROPE;
priority: INT;
LineBreak: IO.BreakProc ~ {RETURN [IF char='\n THEN sepr ELSE other]};
transaction _ DB.EraseSegment[wsdSegment];
MarkInternal[];
ResetSchema[];
DO
priority _ IO.GetInt[s ! ANY => EXIT];
msgSet _ IO.GetTokenRope[s, IO.IDProc ! ANY => EXIT].token;
[] _ IO.SkipWhitespace[s, FALSE];
keyword _ IO.GetTokenRope[s, LineBreak ! ANY => EXIT].token;
AddTriggerInternal[msgSet, DecodeRope[keyword], priority];
ENDLOOP;
MarkInternal[];
};
CloseInternal[];
CarefullyApply[LoadFromStreamInternal];
};
LoadFromFile: PUBLIC PROC [fileName: ROPE] ~ {
s: IO.STREAM _ FS.StreamOpen[
fileName: fileName,
accessOptions: read
];
LoadFromStream[s];
IO.Close[s];
};
GetEncodedChar: PROC [s: IO.STREAM] RETURNS [c: CHAR] ~ {
c _ IO.GetChar[s];
SELECT c FROM
'\\ => {
SELECT IO.GetChar[s] FROM
'n, 'N => RETURN ['\n];
'\\ => RETURN ['\\];
ENDCASE => ERROR;
};
ENDCASE => RETURN [c];
};
PutEncodedChar: PROC [s: IO.STREAM, c: CHAR] ~ {
SELECT c FROM
'\n => IO.PutRope[s, "\\\n"];
'\\ => IO.PutRope[s, "\\\\"];
ENDCASE => IO.PutChar[s, c];
};
DecodeRope: PROC [in: ROPE] RETURNS [out: ROPE] ~ {
outS: IO.STREAM _ IO.ROS[];
inS: IO.STREAM _ IO.RIS[in];
DO
IO.PutChar[outS, GetEncodedChar[inS ! ANY => EXIT]];
ENDLOOP;
out _ IO.RopeFromROS[outS];
};
InvalidateCache: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => NULL;
cacheValid _ FALSE };

TRUSTED { Process.Detach[FORK WatchDBActivity[]] };
END.
‚WalnutSortDBImpl.mesa
Copyright c 1985, 1986 by Xerox Corporation.  All rights reserved.
Eric Nickell, June 27, 1985 10:53:05 am PDT
Dave Rumph, January 13, 1986 5:30:01 pm PST
Donahue, May 8, 1986 8:11:37 am PDT

Walnut DB globals
If open is TRUE, then transaction contains the transaction handle for the segment
Initialize the transaction with the keyword database, already under the monitor lock.
If we end up here, the retries already failed, so signal a database failure.
Should be called after every modification to the DB
Close the transaction with the keyword database.
There was a previous value, so just add the msName to the existing list
Dave Rumph, October 15, 1985 12:52:34 pm PDT
Cleaned up interaction with Walnut Registry when the user changes
changes to: DIRECTORY, WalnutSortDBImpl (IMPORTS), DeclareSegment  DeclareSegmentInternal (local of DeclareSegment) (use of user)

Κ˜š
œ™Icodešœ
Οm
œ7™BJ™+J™+K™#J™—š
Οk	˜	Kšžœ
˜Kšžœ
žœ˜Kš
žœ
žœWžœžœžœ˜Ž
Kšœžœ ˜-Kšœžœžœ˜-Kšœžœ%˜1Kšœžœ	˜Kš
œ
˜
Kšœžœ	˜J˜—šœžœ
ž˜Kšžœ
žœžœžœ4˜FJšžœ
˜Jšœž˜Jšžœ˜J˜Jšžœžœžœ
˜J˜™Jšœžœ˜(J˜Jšœ	žœ
˜J˜Jšœ
žœ˜J˜Jšœžœžœžœ˜XJ˜Jšœžœ)˜3J˜Jšœžœ˜Jšœžœ˜Jšœžœ˜J˜Jšœžœ
žœžœIžœ3žœ˜Ό
J˜Jšœžœ˜J˜Jšœžœžœ
˜J˜Jšœ
žœžœ
˜J˜Jšœ
ž	œ
˜J˜šœ
žœ˜"Jš
œQ™Q—J˜Jšœžœ
˜#Jšœžœžœ
˜—J˜šΟnœžœ˜šžœ
žœ
ž˜
J˜,Jš
œ˜Jš
ž˜—Jš
œ˜J˜—šŸœžœ
žœ˜!Jšžœ
žœžœ
˜šžœ
žœ
žœ˜Jš
œ˜Jšžœ˜—Jšœžœ˜—
code2š
Ÿœžœ
žœ
žœžœ˜2Jšžœ
žœžœ
˜Kšžœ˜Kš
œ˜šžœ˜˜J˜K˜p—Kš
œ˜—J™UJšœ
žœ
˜J˜—šŸœžœ
žœ
žœ˜0Kšœ
žœžœ
˜˜
KšœžœΟc:˜KKšœžœ
˜šžœžœ˜K˜˜	Kšžœžœ	žœ
žœ
žœ
žœ˜DKšžœ
žœ
˜Kšžœžœ˜6K˜—Kš
ž˜š
ž˜š
œ
˜
Kšžœ žœžœ˜DKšœžœžœ
˜ Kšœžœ˜Kš
œ˜—Kš
œL™Lš
œ˜KšžœM˜RK˜—š
œ˜KšžœO˜TK˜—˜Kšžœl˜qK˜——Kšœžœ
˜
—K˜—K˜—J˜šŸœžœ˜Jšœžœ&˜3Jšœ
žœ=˜IJšœžœžœžœ"˜UJ˜—šŸœžœ
žœ 1˜QKšœžœžœ
˜Kšžœžœ
žœ
˜Kšœžœžœ
žœžœ
žœ
žœ
žœ˜…
Kšžœžœ˜$Jšœžœ
˜Jšžœ˜J˜—šŸœžœ
žœ˜Kš
œ3™3Kšœ
žœ
˜K˜K˜K˜—šŸ
œžœ
žœ˜ Kšžœžœ
žœ
˜Jš
žœ žœžœ
žœžœ˜PJšœžœž˜K˜K˜—šŸœžœ
žœ
žœ˜J™0Jšžœ
žœžœ
˜K˜J˜—š
Ÿœžœ
žœ
žœ
žœ˜BKšžœ
žœžœ
˜šŸœžœ˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kš
œ˜——šŸœžœ
žœ˜.Kšœžœžœ=žœ˜ZKšœžœ	˜Kšœžœ8žœ˜Ešžœžœžœ
ž˜'Kšœžœžœ ˜CKšœžœ
žœ˜2Kšœ
žœžœžœ˜3•StartOfExpansion7[x: 
SymTab.Ref, key: 
SymTab.Key, val: 
SymTab.Val]š
žœ
žœ,žœžœžœ˜aK™GKšœžœžœ#˜=šžœ
žœ
ž˜Kšœ+žœ˜FKšœKžœžœ˜tKšžœžœ ;˜L—Kš
œ˜—Kšžœ
˜—Kš
œ˜Kšœ#žœ
˜(K˜K˜Kšžœžœ
žœ˜-K–-[message: 
ROPE, clearFirst: 
BOOL _ FALSE]š
œZ˜ZK˜—š
Ÿœžœ
žœžœžœ
˜UšŸœžœ
žœ˜-Jšœžœ
žœ"˜4Jšœ
žœžœ6˜Rš
žœžœžœžœžœžœ
ž˜]šžœžœžœžœ˜CJš
œ0˜0Jšžœ˜Jšžœ
˜—Jšžœ
˜—Jšžœ˜Kš
œžœžœžœ
žœ
žœžœ˜\K˜—K˜+K˜—šŸ
œžœ
žœ
žœžœžœ
˜RJšžœ
žœžœ
˜šŸœžœ
žœ˜-Jš
œ.˜.J˜—J˜+J˜—š
Ÿ
œžœ
žœ
žœžœ˜<Jšžœ
žœžœ
˜šŸœžœ
žœ˜(Jšœžœ
žœ!˜3Jšžœžœ
žœ
žœ
˜š
ž˜Jšœ
žœžœ6˜RKšœžœ	˜š
žœžœžœžœžœžœ
ž˜]šžœžœžœž˜AJšœžœ˜#—Jšžœ
˜—Jšžœ˜Kšžœžœ
žœ
žœ
˜&Kšžœ"˜$Jšžœ˜Jšžœ˜——K˜&J˜—šŸœžœ
žœ
žœžœ
žœ˜2Kšžœ
žœžœ
˜šŸœž
œ˜'K˜š
œ
˜
Kšœžœžœ=žœ˜ZKšœžœ	˜šžœžœžœ
ž˜+Jšœ	žœžœ"˜IKšžœžœ˜8Kšžœ˜Kšžœžœ˜4Kšžœ˜šžœžœ
žœž˜0Jš
œ;˜;Jš
ž˜—Jšžœ˜Jš
ž˜—Jš
œ˜Kš
œ˜—K˜K˜—K˜%J˜—šŸ
œžœ
žœžœ˜,šœžœ
žœžœ˜J˜J˜Jš
œ˜—Jš
œ˜Jšžœ
˜J˜—šŸœžœ
žœ
žœžœ
žœ˜4Jšžœ
žœžœ
˜šŸœžœ
žœ˜)Kšœžœ
˜Jšœ
žœ
˜Jšœžœžœžœ
žœžœ	˜FJšœžœ˜*J˜J˜š
ž˜Kšœžœžœžœ˜&Jš	œ	žœžœ
žœžœ˜;Kšœžœžœ˜!Kšœ
žœžœžœ˜<K˜:Jš
ž˜—J˜K˜—J˜J˜'J˜—šŸœžœ
žœžœ˜.šœžœ
žœžœ˜J˜J˜Jš
œ˜—J˜Jšžœ
˜J˜—šŸœžœžœ
žœžœžœ˜9Jšœžœ˜šžœž˜
š
œ˜šžœ
žœž˜Jšœ
žœ˜Jšœžœ˜Jšžœžœ
˜—Jš
œ˜—Jšžœžœ˜—J˜—š
Ÿœžœžœ
žœžœ˜0šžœž˜
Jšœžœ˜Jšœžœ˜Jšžœžœ˜—J˜—š
Ÿ
œžœžœžœžœ˜3Jš	œžœ
žœžœ
žœ˜Jš	œžœ
žœžœ
žœ˜š
ž˜Jšžœ$žœžœ˜4Jš
ž˜—Jšœžœ˜J˜—šŸœžœ
žœ
žœ˜&Kšžœ
žœžœ
˜Kšœ
žœ˜—K˜Kšžœžœ˜3Lšžœ
˜—™,K™AKšœΟrœ	‘œ
‘œ(™
—K™—…—#”5