WalnutSortDBImpl.mesa
Copyright © 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
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;
Walnut DB globals
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
];
};
Initialize the transaction with the keyword database, already under the monitor lock.
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;
};
If we end up here, the retries already failed, so signal a database failure.
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 ~ {
Close the transaction with the keyword database.
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 {
There was a previous value, so just add the msName to the existing list
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];
};
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.
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)