-- WalnutDBImpl.mesa
-- Contents: implementation for making changes in Walnut's database
--  this is the monitored access to the database

-- Last Edited by: Willie-Sue, June 7, 1983 4:23 pm

DIRECTORY
    DB,
    IO,
    Rope,
    VFonts USING [CharWidth, StringWidth],
    WalnutDB,
    WalnutLog,
    WalnutSendMail,
    WalnutStream;
    
WalnutDBImpl: CEDAR MONITOR
    IMPORTS
        DB, Rope, VFonts,
        WalnutDB, WalnutLog, WalnutSendMail, WalnutStream
    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

-- ********************************************************

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];
    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: $Walnut, estRelships: 10];
    MsgSetDomain_ DeclareDomain["MsgSet", $Walnut];

    msNumInSet_ DeclareRelation["msNumInSet", $Walnut];
      msNumInSetOf_ DeclareAttribute[msNumInSet, "of", MsgSetDomain, Key]; -- MsgSet
      msNumInSetIs_ DeclareAttribute[msNumInSet, "is", IntType]; -- INT

    mDateCode_ DeclareRelation["mDateCode", $Walnut];
      mDateCodeOf_ DeclareAttribute[mDateCode, "of", MsgDomain, Key];  -- Msg
      mDateCodeIs_ DeclareAttribute[mDateCode, "is", TimeType]; -- Time:

    mSubject_ DeclareRelation["mSubject", $Walnut];
      mSubjectOf_ DeclareAttribute[mSubject, "of", MsgDomain, Key]; -- Msg
      mSubjectIs_ DeclareAttribute[mSubject, "is", StringType]; -- string
    mCategory_ DeclareRelation["mCategory", $Walnut];
      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", $Walnut];
      mInReplyToOf_ DeclareAttribute[mInReplyTo, "of", MsgDomain, OptionalKey]; -- Msg
      mInReplyToIs_ DeclareAttribute[mInReplyTo, "is", StringType]; -- Msg
    mTOCEntry_ DeclareRelation["mTOCEntry", $Walnut];
      mTOCEntryOf_ DeclareAttribute[mTOCEntry, "of", MsgDomain, Key]; -- Msg
      mTOCEntryIs_ DeclareAttribute[mTOCEntry, "is", StringType]; -- string

    mLogPos_ DeclareRelation["mLogPos", $Walnut];
      mLogPosOf_ DeclareAttribute[mLogPos, "of", MsgDomain, Key]; -- Msg
      mPrefixPos_ DeclareAttribute[mLogPos, "prefix", IntType]; -- int
      mHeadersPos_ DeclareAttribute[mLogPos, "headers", IntType]; -- int
    mMsgLength_ DeclareRelation["mMsgLength", $Walnut];
     mMsgLengthOf_ DeclareAttribute[mMsgLength, "of", MsgDomain, Key]; -- Msg
      mMsgLengthIs_ DeclareAttribute[mMsgLength, "length", IntType]; -- int
    mHasBeenRead_ DeclareRelation["mHasBeenRead", $Walnut];
     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.GetName[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.GetName[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, "", "\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.GetName[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 };

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

blankWidth: INT_ VFonts.CharWidth[' ]; -- in default font
blanks: ROPE_ "                                                  "; -- lotsa blanks

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]_ AddMsgToMsgSet[msg, msgSet];    -- use ENTRY proc
        IF ~rExisted THEN newRelList_ CONS[[rel, msgSet], newRelList];
     END;

    [msg, mExisted]_ DeclareMsg[mr.gvID, NewOrOld];
    IF ~mExisted THEN
     BEGIN
--  make up TOC entry
        pos: INT_ mr.gvID.Find["$"]+1;        -- $ is not allowed in names, so it's unique
        date: ROPE_ mr.gvID.Substr[mr.gvID.Find["@", pos]+1, 9];        --magic, almost
        toc: ROPE_ IF mr.from.Equal[WalnutSendMail.userRName, FALSE] OR
          mr.from.Equal[WalnutSendMail.simpleUserName, FALSE] THEN Rope.Concat["To: ", mr.to]
          ELSE mr.from;
        mr.tocEntry_ SquashRopeIntoWidth[Rope.Cat[date, "  ", toc], 170];
        SetMsgAttributes[msg, mr];
        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;
       END        -- new msg
      ELSE    -- see if any new MsgSets were on categoriesList
      BEGIN
        curCatList: LIST OF Value_ GetPList[msg, mCategoryIs];
        found: BOOL_ FALSE;
        FOR newL: LIST OF ROPE_ mr.categoriesList, newL.rest UNTIL newL = NIL DO
          FOR cL: LIST OF Value_ curCatList, cL.rest UNTIL cL = NIL DO
            IF Rope.Equal[newL.first, GetName[V2E[cL.first]], FALSE] THEN
              { found_ TRUE; EXIT};
          ENDLOOP;
        IF ~found THEN CategoryRelshipList[newL.first];
        ENDLOOP;
      END;
  END;

SetMsgAttributes: ENTRY PROC[msg: Msg, mr: WalnutLog.MsgRec] =
  BEGIN ENABLE UNWIND => NULL;
    []_ SetP[msg, mDateCodeIs, T2V[mr.dateCode]];
    []_ 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;

SquashRopeIntoWidth: PROC[s: ROPE, colWidth: INT] RETURNS[ROPE] =
  -- Truncates s with "..." or expands it with blanks, so that it is about
  -- colWidth characters wide.  Not exact, uses a few heuristics here...
  BEGIN blankCount: INT;
  width: INT_ VFonts.StringWidth[s];
  DO
   IF width<= colWidth THEN EXIT;
    -- truncate
    BEGIN guessLength: INT_  s.Length[] * colWidth / width;
     s_ Rope.Cat[s.Substr[0, MAX[0, guessLength-4]], "..."];
     width_ VFonts.StringWidth[s];
    END;
  ENDLOOP;

  -- At this point s is shorter than colWidth and we want to extend it with blanks
  blankCount_ (colWidth - width) / blankWidth;
  IF blankCount>0 THEN
    s_ Rope.Cat[s, Rope.Substr[blanks, 0, MIN[blankCount, blanks.Length[]]]];
  RETURN[s]
  END;

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

AddTo: INTERNAL PROC[msg: Msg, msgSet: MsgSet] RETURNS[rel: Relship, existed: BOOL] =
  BEGIN
    avl: AttributeValueList;

    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_ CreateRelship[mCategory, avl];
    ChangeNumInSet[msgSet, 1];
    SetUpdatesPendingProc[TRUE];
  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 num < 0 THEN ERROR;
    []_ SetP[msgSet, msNumInSetIs, I2V[num]];
  END;

END.