-- 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.