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