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

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

ROPE: TYPE ~ Rope.ROPE;

wsdSegment: DB.Segment ~ $WalnutSortDef;
kwDomain, msgSetDomain: DB.Domain;
trigger: DB.Relation;
trgKwAttribute, trgMSAttribute, trgPrAttribute: DB.Attribute;
open: BOOLEAN _ FALSE;
cachedTriggerSet: TriggerSet _ NIL;
cacheValid: BOOLEAN _ FALSE;
DeclareSegment: PUBLIC ENTRY PROC [user: ROPE] ~ {
ENABLE UNWIND => NULL;
DeclareSegmentInternal: INTERNAL PROC ~ {
DB.Initialize[];
CloseInternal[! DB.Error, DB.Aborted => CONTINUE];
DB.DeclareSegment[
filePath: UserProfile.Token [
key: "WalnutSort.SegmentFile",
default: Rope.Cat["[", UserProfile.Token["Alpine.Server", "Luther"], ".Alpine]<", user, ">WalnutSort.Segment"]
],
segment: wsdSegment
];
};
CarefullyApply[DeclareSegmentInternal];
cacheValid _ FALSE;
};
CarefullyApply: INTERNAL PROC [action: PROC] ~ {
errorMsg: ROPE _ NIL;
{
count: INT _ 5;	--Try twice for most errors, but five times for DB.Failure
WHILE count > 0 DO {
action[ !
DB.Aborted => IF count#1 THEN GOTO OneRetry ELSE GOTO SignalAborted;
DB.Error => IF count#1 THEN GOTO OneRetry ELSE GOTO SignalError;
DB.Failure => IF count#1 THEN GOTO KeepRetrying ELSE {
errorMsg _ info;
GOTO SignalFailure;
};
];
EXIT
EXITS
OneRetry => {
DB.AbortTransaction[DB.GetSegmentInfo[wsdSegment].trans ! DB.Failure => CONTINUE];
DB.OpenTransaction[wsdSegment ! DB.Error, DB.Aborted, DB.Failure => CONTINUE];
count _ MIN[count, 2] - 1;
};
KeepRetrying => {
DB.AbortTransaction[DB.GetSegmentInfo[wsdSegment].trans ! DB.Failure => CONTINUE];
DB.OpenTransaction[wsdSegment ! DB.Error, DB.Aborted, DB.Failure => CONTINUE];
count _ count - 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;
};
};
OpenInternal: INTERNAL PROC ~ {	--Should only be called from under CarefullyApply
InitializeWalnutSortDBParms: PROC ~ {
IF open THEN RETURN;
kwDomain _ DB.DeclareDomain["keyword", wsdSegment];
msgSetDomain _ DB.DeclareDomain["msgSet", wsdSegment];
trigger _ DB.DeclareRelation["trigger", wsdSegment];
trgKwAttribute _ DB.DeclareAttribute[trigger, "Keyword", kwDomain];
trgMSAttribute _ DB.DeclareAttribute[trigger, "MsgSet", msgSetDomain];
trgPrAttribute _ DB.DeclareAttribute[trigger, "Priority", DB.IntType];
[] _ DB.DeclareIndex[trigger, LIST[trgPrAttribute, trgKwAttribute]];
DB.MarkTransaction[DB.GetSegmentInfo[wsdSegment].trans];
open _ TRUE;
};
DB.OpenTransaction[wsdSegment ! DB.Error => IF code=TransactionAlreadyOpen THEN CONTINUE];
InitializeWalnutSortDBParms[];	--Getting here means that we have an open transaction
};

MarkInternal: INTERNAL PROC ~ {		--Should be called after every modification to the DB
cacheValid _ FALSE;
};

CloseInternal: INTERNAL PROC ~ {	--Should only be called from under CarefullyApply
IF ~open THEN RETURN;
DB.CloseTransaction[DB.GetSegmentInfo[wsdSegment].trans];
open _ FALSE;
};

Close: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => NULL;
CarefullyApply[CloseInternal];
};
GetTriggerSetFromDB: PUBLIC ENTRY PROC RETURNS [t: TriggerSet] ~ {
ENABLE UNWIND => NULL;
MakeTriggerSetNil: PROC ~ {
cachedTriggerSet _ NIL;
cacheValid _ FALSE;
t _ NIL;
};
GetTriggerSetFromDBInternal: INTERNAL PROC ~ {
OpenInternal[];
{
rSet: DB.RelshipSet ~ DB.RelationSubset[r: trigger, constraint: LIST [[trgPrAttribute, DB.I2V[FIRST[INT]], DB.I2V[LAST[INT]]], [trgKwAttribute, DB.S2V["\000"], DB.S2V["\377"]]]];
r: DB.Relship;

t _ NEW[TriggerSetRep _ [mapping: SymTab.Create[], clientData: NIL]];
UNTIL (r _ DB.NextRelship[rSet])=NIL DO
key: ROPE ~ DB.GetFS[r, trgKwAttribute];
msName: ROPE ~ DB.GetFS[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;
};
cachedTriggerSet _ t; cacheValid _ TRUE;
CloseInternal[];
};

IF cacheValid THEN RETURN [cachedTriggerSet];
CarefullyApply[GetTriggerSetFromDBInternal !
WalnutSortMail.Error => MakeTriggerSetNil[]];
};
AddTriggerInternal: INTERNAL PROC [msName, keyword: ROPE, priority: CARDINAL _ 10] ~ {
AddTriggerInternalInternal: INTERNAL PROC ~ {
msgSet: DB.Entity _ DB.DeclareEntity[msgSetDomain, msName];
kw: DB.Entity _ DB.DeclareEntity[kwDomain, keyword];
[] _ DB.DeclareRelship[trigger, LIST[[trgKwAttribute, kw], [trgMSAttribute, msgSet], [trgPrAttribute, DB.I2V[priority]]]];
};
CarefullyApply[AddTriggerInternalInternal];
};
AddTrigger: PUBLIC ENTRY PROC [msName, keyword: ROPE, priority: CARDINAL _ 10] ~ {
ENABLE UNWIND => NULL;
AddTriggerInternalInternal: INTERNAL PROC ~ {
OpenInternal[];
AddTriggerInternal[msName, keyword, priority];
MarkInternal[];
CloseInternal[];
};
CarefullyApply[AddTriggerInternalInternal];
};
DeleteTrigger: PUBLIC ENTRY PROC [msName, keyword: ROPE] ~ {
ENABLE UNWIND => NULL;
DeleteTriggerInternal: INTERNAL PROC ~ {
OpenInternal[];
{
msgSet: DB.Entity _ DB.DeclareEntity[msgSetDomain, msName];
kw: DB.Entity _ DB.DeclareEntity[kwDomain, keyword];
relshipToDestroy: DB.Relship _ DB.DeclareRelship[trigger, LIST[[trgKwAttribute, kw], [trgMSAttribute, msgSet]], OldOnly ! DB.Error => GOTO Quit];
IF relshipToDestroy=NIL THEN RETURN;
DB.DestroyRelship[relshipToDestroy];
DB.MarkTransaction[DB.GetSegmentInfo[wsdSegment].trans];
EXITS
Quit => RETURN;
};
MarkInternal[];
CloseInternal[];
};
CarefullyApply[DeleteTriggerInternal];
};
DumpToStream: PUBLIC ENTRY PROC [s: IO.STREAM] ~ {
ENABLE UNWIND => NULL;
DumpToStreamInternal: INTERNAL PROC ~ {
OpenInternal[];
{
rels: DB.RelshipSet _ DB.RelationSubset[r: trigger, constraint: LIST [[trgPrAttribute, DB.I2V[FIRST[INT]], DB.I2V[LAST[INT]]], [trgKwAttribute, DB.S2V["\000"], DB.S2V["\377"]]]];		--Get all triggers, but ordered
rel: DB.Relship;
WHILE (rel _ DB.NextRelship[rels]) # NIL DO
keyword: ROPE _ DB.GetFS[rel, trgKwAttribute];
IO.PutRope[s, DB.GetFS[rel, trgPrAttribute]];	--Put out the priority
IO.PutChar[s, '\t];
IO.PutRope[s, DB.GetFS[rel, trgMSAttribute]];	--Put out the message set triggered
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;
};
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]};

CloseInternal[];
DB.EraseSegment[wsdSegment];
OpenInternal[];
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;
};
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

Walnut DB globals
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.
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™+J™—š
Οk	˜	Kšžœ
˜Kšžœ
žœ˜Kš
žœ
žœMžœžœžœ˜„
Kšœžœžœ˜&Kšœžœ%˜1Kšœžœ	˜Kš
œ
˜
Kšœžœ	˜J˜—šœžœ
ž˜Kšžœ
žœžœžœ+˜=Jšžœ
˜Jšœž˜Jšžœ˜J˜Jšžœžœžœ
˜J˜™Jšœžœ˜(Jšœžœ˜"Jšœ	žœ
˜Jšœ0žœ˜=Jšœžœžœ
˜Jšœžœ
˜#Jšœžœžœ
˜—
code2š
Οnœžœ
žœ
žœžœ˜2Jšžœ
žœžœ
˜šŸœž
œ˜)Kšžœ˜Kšœžœžœžœ˜2šžœ˜˜J˜K˜nK˜—Kš
œ˜Jš
œ˜—K˜—J™UJš
œ'˜'Jšœ
žœ
˜J˜—šŸœžœ
žœ
žœ˜0Kšœ
žœžœ
˜˜
KšœžœΟc:˜Jšžœžœ˜˜	Kšžœžœ	žœ
žœ
žœ
žœ˜DKšžœ
žœ	žœ
žœ
žœ
žœ
˜@š
žœžœ	žœ
žœžœ˜6Kš
œ˜Kšžœ˜K˜—K˜—Kš
ž˜š
ž˜š
œ
˜
Kšžœžœ$žœžœ˜RKš
žœžœžœ
žœžœ˜NKšœžœ˜Kš
œ˜—š
œ˜Kšžœžœ$žœžœ˜RKš
žœžœžœ
žœžœ˜NKš
œ˜Kš
œ˜—Kš
œL™Lš
œ˜KšžœM˜RK˜—š
œ˜KšžœO˜TK˜—˜Kšžœl˜qK˜——Kšœ
žœ
˜
—K˜—K˜—šŸœžœ
žœ 1˜QšŸœžœ˜%Kšžœžœ
žœ
˜Jšœžœ&˜3Jšœžœ%˜6šœ
žœ(˜4Jšœžœ0˜CJšœžœ3˜FJšœžœ'žœ
˜FJšœžœžœ"˜D—Jšžœžœ#˜8Jšœžœ
˜K˜—Kš
žœžœ
žœžœ
žœ˜ZKšœ 5˜TJ˜J˜—šŸœžœ
žœ 5˜VKšœ
žœ
˜K˜K˜—šŸ
œž
œ 1˜RKšžœžœ
žœ
˜Jšžœžœ#˜9Jšœžœ
˜
K˜K˜—šŸœžœ
žœ
žœ˜J™0Jšžœ
žœžœ
˜K˜J˜—š
Ÿœžœ
žœ
žœ
žœ˜BKšžœ
žœžœ
˜šŸœžœ˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kš
œ˜—šŸœžœ
žœ˜.Kš
œ˜š
œ
˜
Kšœžœžœ(žœžœžœ
žœžœžœ
žœžœžœ˜²
Kšœžœ	˜K˜Kšœžœ8žœ˜Ešžœžœžœ
ž˜'Kšœžœžœ˜(Kšœžœžœ˜+Kšœ
žœžœžœ˜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šžœžœ
žœ˜-K–-[message: 
ROPE, clearFirst: 
BOOL _ FALSE]š
œZ˜Z—K˜—šŸœž
œžœžœ
˜VšŸœž
œ˜-Kšœžœ
žœ%˜;Jšœžœ
žœ"˜4KšœžœžœBžœ˜zK˜—K˜+K˜—šŸ
œžœ
žœ
žœžœžœ
˜RJšžœ
žœžœ
˜šŸœžœ
žœ˜-Kš
œ˜Jš
œ.˜.J˜J˜K˜—J˜+J˜—š
Ÿ
œžœ
žœ
žœžœ˜<Jšžœ
žœžœ
˜šŸœž
œ˜(K˜š
œ
˜
Jšœžœ
žœ%˜;Jšœžœ
žœ"˜4Kšœžœžœžœ<žœ
žœ˜‘
Kšžœžœ
žœ
žœ
˜$Kšžœ"˜$Jšžœžœ#˜8š
ž˜Jšœžœ
˜—Kš
œ˜—K˜K˜K˜—K˜&J˜—šŸœžœ
žœ
žœžœ
žœ˜2Kšžœ
žœžœ
˜šŸœž
œ˜'K˜š
œ
˜
Kšœžœžœ(žœžœžœ
žœžœžœ
žœžœžœ ˜Σ
Kšœžœ	˜šžœžœžœ
ž˜+Jšœ	žœžœ˜.Kšžœžœ ˜DKšžœ˜Kšžœžœ #˜QKšžœ˜šžœžœ
žœž˜0Jš
œ;˜;Jš
ž˜—Jšžœ˜Jš
ž˜—Kš
œ˜—K˜K˜—K˜%J˜—šŸ
œžœ
žœžœ˜,šœžœ
žœžœ˜J˜J˜Jš
œ˜—Jš
œ˜Jšžœ
˜J˜—šŸœžœ
žœ
žœžœ
žœ˜4Jšžœ
žœžœ
˜šŸœžœ
žœ˜)Kšœžœ
˜Jšœ
žœ
˜Jšœžœžœžœ
žœžœ	˜FJ˜J˜Jšžœ˜J˜š
ž˜Kšœžœžœžœ˜&Jš	œ	žœžœ
žœžœ˜;Kšœžœžœ˜!Kšœ
žœžœžœ˜<K˜:Jš
ž˜—J˜J˜K˜—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šœ
žœ
˜L˜—Lšžœ
˜—™,K™AKšœΟrœ	‘œ
‘œ(™
—K™—…—"H2)