-- File: WalnutDBAccessImpl.mesa
-- Contents:
-- types and procedures for conversion of record-form message to entity.
-- actual access to walnut database (WalnutDBLockImpl does the locking)

-- Created by: Willie-Sue November 2, 1982
-- Last edited by:
-- Rick Cattell on XXX
-- Willie-Sue Hoo-Hah on March 24, 1983 10:06 am

DIRECTORY
 DB,
 DateAndTime,
 Rope,
 IO,
 VFonts,
 WalnutDB,
 WalnutDBAccess,
 WalnutDBLock,
 WalnutDBLog,
 WalnutParse,
 WalnutSendMail,
 WalnutWindow;
 
WalnutDBAccessImpl: CEDAR PROGRAM
IMPORTS DB, DateAndTime, Rope, VFonts,
 WalnutDB, WalnutDBLock, WalnutDBLog, WalnutSendMail, WalnutWindow
EXPORTS WalnutDB, WalnutDBAccess =
  
BEGIN OPEN DB, WalnutDB;

-- ********************************************************
-- Walnut DB types and data

SchemaVersionTime:
  PUBLIC GreenwichMeanTime← DateAndTime.Parse["March 24, 1983 9:24 am"].dt;

Msg, MsgSet: TYPE = Entity;

MsgDomain: PUBLIC Domain;
MsgSetDomain: PUBLIC Domain;

walnutLogInfo: PUBLIC Relation; -- used to keep current info about the log file
wExpectedLength: PUBLIC Attribute; -- int (how long the log file is)
wExpectedDBPos: PUBLIC Attribute; -- int (how much of the log has been parsed into Msgs)
wStartExpungePos: PUBLIC Attribute; -- int (where in log file the last/current expunge started)
wCopyInProgress: PUBLIC Attribute; -- bool (TRUE while Copying onto tail of log file)
wSchemaVersion: PUBLIC Attribute; -- time (for keeping track of changes in walnut's schema)
walnutInfoRelship: PUBLIC Relship;  -- need fetch & check only once

-- 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, from date in msg
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; --Time
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

-- schemaVersion is num found in database
SchemaMismatch: PUBLIC SIGNAL[schemaVersion: GreenwichMeanTime] = CODE;

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

blankWidth: INT← VFonts.CharWidth[' ]; -- in default font
blanks: ROPE← " "; -- lotsa blanks

-- ********************************************************
DoInitializeDBVars: PUBLIC PROC =
BEGIN
 MsgDomain← DeclareDomain[name: "Msg", segment: $Walnut, estRelships: 10];
 MsgSetDomain← DeclareDomain["MsgSet", $Walnut];

 walnutLogInfo← DeclareRelation["walnutLogInfo", $Walnut, OldOnly];
 IF walnutLogInfo#NIL THEN DO  -- check schema version numbers
  { rs: RelshipSet;
  curVersion: GreenwichMeanTime;
  wSchemaVersion← DeclareAttribute[walnutLogInfo, "wSchemaVersion", TimeType];
  rs← RelationSubset[walnutLogInfo];
  walnutInfoRelship← NextRelship[rs];
  -- should only be one relship in this relation
  IF NextRelship[rs] # NIL THEN ERROR;
  IF walnutInfoRelship = NIL THEN {ReleaseRelshipSet[rs]; EXIT};
  ReleaseRelshipSet[rs];
  curVersion← V2T[DB.GetF[walnutInfoRelship, wSchemaVersion]];
  IF curVersion#SchemaVersionTime THEN SIGNAL SchemaMismatch[curVersion];
  EXIT;
  };
  ENDLOOP
 ELSE
  { walnutLogInfo← DeclareRelation["walnutLogInfo", $Walnut];
  wSchemaVersion← DeclareAttribute[walnutLogInfo, "wSchemaVersion", TimeType];
  };

  wExpectedLength← DeclareAttribute[walnutLogInfo, "wExpectedLength", IntType];
  wExpectedDBPos← DeclareAttribute[walnutLogInfo, "wExpectedDBPos", IntType];
  wStartExpungePos← DeclareAttribute[walnutLogInfo, "wStartExpungePos", IntType];
  wCopyInProgress← DeclareAttribute[walnutLogInfo, "wCopyInProgress", BoolType];

 BEGIN
  rs: RelshipSet← RelationSubset[walnutLogInfo];
  walnutInfoRelship← NextRelship[rs];
  -- should only be one relship in this relation
  IF NextRelship[rs] # NIL THEN ERROR;
  IF walnutInfoRelship = NIL THEN walnutInfoRelship← CreateRelship[walnutLogInfo];
  ReleaseRelshipSet[rs];
 END;
  []← SetF[walnutInfoRelship, wSchemaVersion, T2V[SchemaVersionTime]];

 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

 WalnutWindow.activeMsgSet← DeclareEntity[MsgSetDomain, "Active"];  -- NewOrOld
 WalnutWindow.deletedMsgSet← DeclareEntity[MsgSetDomain, "Deleted"];
END;

DoMsgRecToMsg: PUBLIC PROC[mr: MsgRec] RETURNS[msg: Msg, existed: BOOL] =
-- Converts msg from record to entity form
BEGIN
date, toc: ROPE;
pos: INT;
[msg, existed] ← DoDeclareMsg[mr.gvID];
mr.msg← msg;
IF existed THEN RETURN;

-- make up TOC entry
pos← mr.gvID.Find["$"]+1;  -- $ is not allowed in names, so it's unique
date← mr.gvID.Substr[mr.gvID.Find["@", pos]+1, 9];  --magic, almost
toc← 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];

-- mCategoryIs is set by the receiver, so can update displays
[]← DB.SetP[e: msg, aIs: mDateCodeIs, v: T2V[mr.dateCode]];
[]← DB.SetP[e: msg, aIs: mInReplyToIs, v: S2V[mr.inReplyTo]];
[]← DB.SetP[e: msg, aIs: mHasBeenReadIs, v: B2V[mr.hasBeenRead]];
[]← DB.SetP[e: msg, aIs: mTOCEntryIs, v: S2V[mr.tocEntry]];
[]← DB.SetP[e: msg, aIs: mSubjectIs, v: S2V[mr.subject]];
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;

GetExpectedLogLength: PUBLIC PROC RETURNS[INT] =
-- Retrieves last stored log length from database (used for recovery from crash)
{ RETURN[WalnutDBLock.GetWalnutInfo[wExpectedLength]]};

GetExpectedDBLogPos: PUBLIC PROC RETURNS[INT] =
-- Retrieves last stored DB log pos from database (used for recovery from crash)
{ RETURN[WalnutDBLock.GetWalnutInfo[wExpectedDBPos]]};

GetStartExpungePos: PUBLIC PROC RETURNS[INT] =
-- Retrieves the time at which new mail was last retrieved
{ RETURN[WalnutDBLock.GetWalnutInfo[wStartExpungePos]]};

GetCopyInProgress: PUBLIC PROC RETURNS [BOOL] =
-- returns TRUE if a copy onto tail of log file is in progress
{ RETURN[WalnutDBLock.IsCopyInProgress[]]};

DoDeclareMsg: PUBLIC PROC[mName: ROPE] RETURNS [msg: Msg, existed: BOOL] =
-- Creates a new Msg entity, 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 returns existed=TRUE.
BEGIN
msg← DeclareEntity[MsgDomain, mName, OldOnly];
IF msg#NIL THEN RETURN[msg, TRUE];
msg← DeclareEntity[MsgDomain, mName];
WalnutWindow.SetWalnutUpdatesPending[TRUE];
RETURN[msg, FALSE]
END;

DoDeclareMsgSet: PUBLIC PROC[mName: ROPE] RETURNS [msgSet: MsgSet, existed: BOOL] =
-- Creates a new MsgSet entity, and sets its name to be mName.
-- is called when user creates a message set, or reads a log file
-- If the MsgSet already exists, returns it.
BEGIN
msgSet← DeclareEntity[MsgSetDomain, mName, OldOnly];
IF msgSet#NIL THEN RETURN[msgSet, TRUE];
msgSet← WalnutDBLog.DoCreateMsgSet[mName];
WalnutWindow.SetWalnutUpdatesPending[TRUE];
 RETURN[msgSet, FALSE];
END;

-- ********************************************************
DoEraseP: PUBLIC PROC[m: Msg, prop: Attribute, v: Entity] =
BEGIN
-- UnSets the value of prop for m from v.
-- Useful when m has list value for this prop and want to remove one elt.
r: Relation← V2E[GetP[prop, aRelationIs]];
first: Attribute← FirstAttributeExcept[r, prop];
rs: LIST OF Relship←
 RelshipSetToList[RelationSubset[V2E[GetP[first, aRelationIs]], LIST[[first, m]] ]];

FOR rsT: LIST OF Relship← rs, rsT.rest UNTIL rsT=NIL DO
IF Eq[v, V2E[GetF[rsT.first, prop]]] THEN
{ DestroyRelship[rsT.first]; WalnutWindow.SetWalnutUpdatesPending[TRUE]}
ENDLOOP;
END;

FirstAttributeExcept: PROC[r: Relation, exc: Attribute] RETURNS [Attribute] =
-- Returns first attribute of r unless it's exc, in which case it returns second
BEGIN es: LIST OF Attribute← VL2EL[GetPList[r, aRelationOf]];
first: Attribute← es.first;
IF Eq[first, exc] THEN first← es.rest.first;
RETURN[first]
END;

DoNameToEntity: PUBLIC PROC[d: Domain, name: ROPE, oldOnly: BOOL]
  RETURNS[e: Entity] =
BEGIN
 e← DeclareEntity[d, name, OldOnly];
 IF e = NIL AND ~oldOnly THEN e← DB.DeclareEntity[d, name, NewOnly]
END;

DoGetEntitiesInDomain: PUBLIC PROC[d: Domain, alphaOrder: BOOL]
  RETURNS[eL: LIST OF Entity] =
-- returns list of entities in given domain
BEGIN
 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;

DoRelationSubsetList: PUBLIC PROC[r: Relation, constraint: AttributeValueList← NIL]
  RETURNS[relList: LIST OF Relship] =
BEGIN
 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;

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

EntityInList: PUBLIC PROC[e: Entity, el: LIST OF Value] RETURNS [BOOL] = {
FOR elT: LIST OF Value← el, elT.rest UNTIL elT=NIL DO
IF Eq[e, V2E[elT.first]] THEN RETURN[TRUE] ENDLOOP;
RETURN[FALSE] };

EntityListToNameList: PUBLIC PROC [el: LIST OF Value] RETURNS [nl: LIST OF RName] =
-- Turns a list of entities into a list of names
BEGIN
IF el=NIL THEN RETURN[NIL]
ELSE RETURN[CONS[V2S[GetName[V2E[el.first]]], EntityListToNameList[el.rest]]];
END;
END.

ChangeLog:
WSH on March 4, 1983: strip off RName & DateCode stuff