
<<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];
        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.
<<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)>>
    <<>>