-- File: WalnutFileImpl.mesa
-- Contents:
-- procedures for reading & writing Walnut log-Style files
-- This module is NOT a MONITOR; its assumes that its caller has a lock on the
-- stream if that is appropriate

-- Created by: Willie-Sue on October 15, 1982
-- Last edited by:
-- Rick Cattell on XXX
-- Willie-Sue on March 24, 1983 3:35 pm
-- Last Edited by: Woosh, March 28, 1983 10:26 am

DIRECTORY
DB,
IO,
 GVBasics USING[ItemHeader, ItemType],
 GVRetrieve USING [Failed, GetBlock, Handle, NextItem],
 Rope,
 Runtime,
 WalnutDB,
 WalnutDBLog,
 WalnutWindow;

WalnutFileImpl: CEDAR PROGRAM
IMPORTS DB, IO, GVRetrieve, Rope, Runtime, WalnutDB, WalnutDBLog, WalnutWindow
EXPORTS WalnutDBLog =
  
BEGIN OPEN WalnutDB, WalnutDBLog, DB;

ROPE: TYPE = Rope.ROPE;
TiogaCTRL: GVBasics.ItemType;

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

ReadPrefixInfo: PUBLIC PROC[strm: IO.STREAM, headersPos: INT]
  RETURNS[msgID: ROPE, categories: ROPE, outOfSynch: BOOL] =
BEGIN
 curPos: INT;
 outOfSynch← FALSE;

UNTIL (curPos← strm.GetIndex[]) = headersPos DO
  tag, value: ROPE;
IF curPos > headersPos THEN {outOfSynch← TRUE; RETURN};
  [tag, value]← TagAndValue[h: strm, inc: 2];
IF Rope.Equal[tag, msgIDRope, FALSE] THEN msgID← value
ELSE IF Rope.Equal[tag, categoriesRope, FALSE] THEN categories← value;
ENDLOOP;
END;

TagAndValue: PUBLIC PROC[h: IO.Handle, inc: INT] RETURNS[tag, value: ROPE] =
BEGIN
line: ROPE← GetLine[h];
pos: INT← line.Find[":"];
IF pos < 0 THEN RETURN;
tag← line.Substr[0, pos];
value← line.Substr[pos+inc, Rope.MaxLen ! Runtime.BoundsFault => {tag← NIL; CONTINUE}];
END;

ReadStartOfMsg: PUBLIC PROC[strm: IO.STREAM, doReport: BOOL]
RETURNS[startPos, prefixLength, entryLength: INT, entryChar: CHAR] =
BEGIN ENABLE IO.EndOfStream => GOTO eoS;
line: ROPE;
prefixLength← entryLength← 0;
entryChar← 'X;  -- not a valid entryType char

IF strm.EndOf[] THEN RETURN;
startPos← strm.GetIndex[];
line← GetLine[strm];
IF NOT line.Equal["*start*"] THEN
BEGIN
foo: INT← startPos;
IF doReport THEN
 WalnutWindow.Report[
  IO.PutFR["**start** not found at pos %g. Skipping to next entry.", IO.int[startPos]]];
UNTIL line.Equal["*start*"] DO
IF strm.EndOf[] THEN RETURN;
  startPos← strm.GetIndex[]; line← GetLine[strm] ENDLOOP;
END;

-- Read entry info line from log, e.g.: 00101 00029 US+
entryLength← strm.GetInt[];
prefixLength← strm.GetInt[];
line← GetLine[strm];
entryChar← line.Fetch[line.Length[]-1];

EXITS
eoS => {entryLength← -1; RETURN};
END;

RopeFromStream: PUBLIC PROC[strm: IO.STREAM, len: INT] RETURNS[ROPE] =
-- reads arbitrary length ROPE from a stream
BEGIN
Get1: SAFE PROC RETURNS[CHAR] = CHECKED {RETURN[strm.GetChar[]]};
RETURN[Rope.FromProc[len, Get1]];
END;

GetLine: PROC[h: IO.STREAM] RETURNS[r: ROPE] =
BEGIN
 r← h.GetSequence[];
 []← h.GetChar[ ! IO.EndOfStream => CONTINUE];  -- read the CR
END;

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

MakeLogEntry: PUBLIC PROC [
entryType: LogEntryType, entryText: ROPE, strm: IO.STREAM, msgID: ROPENIL]
RETURNS [INT] =
-- Puts entryText out in Laurel format on the given stream.
-- There are four kinds of entries:
-- (1) messages: entryText is the header and body of the message
-- (2) insertions: entryText is of form (insertion of new relship):
-- Relation: relation
-- attr1: xxx
-- attr2: yyy
-- or of the form (for insertion of new entity):
-- Domain: domain
-- name: xxx
-- (3) deletions: entryText same form as above, but represents deletion of that relship or entity
-- (4) hasbeenread: entryText is the messageID

-- Returns integer position in file of end of log entry.
BEGIN OPEN IO;
typeChar: CHAR;
length: INT← entryText.Length[];
prefixLen: INT← minPrefixLength + msgID.Length[];   -- magic number
isMessage: BOOL← (entryType=message) OR (entryType=newMessage);

Put1: SAFE PROC[c: CHAR] RETURNS[stop: BOOL] = CHECKED
{ strm.PutChar[c]; RETURN[FALSE]};

SELECT entryType FROM
message => typeChar← ' ;
newMessage => typeChar← '?;
insertion => typeChar← '+;
deletion => typeChar← '-;
hasbeenread => typeChar← '←
ENDCASE;

-- can't fool with msg if it has formatting, so don't ever add CR at end
-- IF isMessage THEN
-- { IF entryText.Fetch[length-1] # CR THEN
-- { entryText← Rope.Concat[entryText, "\n"]; length← length + 1};
-- };

strm.SetIndex[strm.GetLength[]];
strm.PutF["**start**\n%05d %05d US%g\n",
    int[prefixLen+length], int[prefixLen], char[typeChar]];

-- strm.Put[ rope[entryText] ] doesn't work if entryText.Length > 77777B
IF msgID.Length[]#0 THEN strm.PutRope[msgID];
IF entryText.Length[] < 77777B THEN strm.PutRope[entryText]
ELSE []← Rope.Map[base: entryText, action: Put1];
strm.Flush[];  -- flush after every write
RETURN[strm.GetIndex[]]
END;

GVLogEntry: PUBLIC PROC [gvH: GVRetrieve.Handle, strm: IO.STREAM, prefix: ROPE]
  RETURNS [lastIndex: INT, ok: BOOL] =
BEGIN
 startPos: INT← strm.GetLength[];  -- where this message begins
 strm.SetIndex[startPos];

BEGIN ENABLE GVRetrieve.Failed => GOTO gvFailed;

 prefixLen: INT← minPrefixLength + prefix.Length[];

 msgLen, lenWritten: INT← 0;
 prefixWritten, ctrlInfo: BOOLFALSE;

WritePrefix: PROC =
BEGIN
  strm.PutF["**start**\n%05d %05d US%g\n",
    IO.int[prefixLen+msgLen], IO.int[prefixLen], IO.char['?]];
  strm.PutRope[prefix];
  lenWritten← msgLen;
  prefixWritten← TRUE;
END;

CopyItemToLog: PROC =
BEGIN
-- 
strm.SetIndex[strm.GetLength[]]; --  -- make sure at end
DO
  bytes: INT;
  IF (bytes← GVRetrieve.GetBlock[gvH, copyBuffer, 0, 512]) = 0 THEN EXIT;
  copyBuffer.length← bytes;  -- grapevineUser bug
  strm.PutBlock[copyBuffer];
ENDLOOP;
END;

DO
item: GVBasics.ItemHeader ← GVRetrieve.NextItem[gvH];
SELECT item.type FROM
PostMark, Sender, ReturnTo => ERROR;
Recipients, Capability, Audio, updateItem, reMail => NULL;
Text =>  -- text needs to end in CR (for parsing & making log file readable)
{ IF ctrlInfo THEN ERROR;  -- items in wrong order!!!
msgLen← msgLen + LOOPHOLE[item.length, INT];
IF ~prefixWritten THEN WritePrefix[];
CopyItemToLog[];
};
TiogaCTRL =>
{ ctrlInfo← TRUE;
msgLen← msgLen + LOOPHOLE[item.length, INT];
CopyItemToLog[];
};
LastItem => EXIT;
ENDCASE => LOOP;
ENDLOOP;

IF ~ctrlInfo THEN
  { ch: CHAR;
  strm.SetIndex[strm.GetLength[]-1];
IF (ch← strm.GetChar[]) # '\n THEN {strm.PutChar['\n]; msgLen← msgLen + 1};
  };
IF msgLen # lenWritten THEN { strm.SetIndex[startPos]; WritePrefix[]};
 strm.Flush[];  -- flush after write
RETURN[strm.GetLength[], TRUE];

EXITS
gvFailed => {strm.SetIndex[startPos]; strm.SetLength[startPos]; RETURN[startPos, FALSE]};
END;
END;

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-- this used to be in WalnutDBLogImpl, until that file got too big

OldMessageFile: PUBLIC PROC[strm: IO.STREAM, defaultPrefix: ROPE]
  RETURNS [ok: BOOL] =
BEGIN ENABLE UNWIND => NULL;
DO
beginMsgPos, msgLength, entryLength, prefixLength: INT;
msgID, msgText, prefix, categories: ROPE;
outOfSynch: BOOLFALSE;

[beginMsgPos, prefixLength, entryLength, ]← ReadStartOfMsg[strm, TRUE];
IF entryLength = -1 THEN RETURN[FALSE];
IF (entryLength=0) OR (entryLength=prefixLength) THEN EXIT; -- Hardy's null message at end
IF IO.PeekChar[strm] = '@ THEN strm.SetIndex[beginMsgPos + prefixLength] -- hardy file
ELSE [msgID, categories, outOfSynch]← ReadPrefixInfo[strm, beginMsgPos+prefixLength];
IF outOfSynch THEN
  { WalnutWindow.Report["Can't find prefix info; skipping to next entry"];
  strm.SetIndex[beginMsgPos + entryLength];
LOOP
};

 prefix←
IF categories#NIL THEN Rope.Cat[categoriesRope, ": ", categories, "\n"] ELSE defaultPrefix;

IF msgID # NIL THEN prefix← Rope.Cat[msgIDRope, ": ", msgID, "\n", prefix];

 msgLength← entryLength-prefixLength;
 msgText← RopeFromStream[strm, msgLength];
 WalnutDB.AddMessageToLog[entryText: msgText, prefix: prefix];
 WalnutWindow.ReportRope["."];
ENDLOOP;
RETURN[TRUE];
END;

AddLogEntries: PUBLIC PROC [logStream: IO.STREAM, startPos: INT] RETURNS[success: BOOL] =
BEGIN
doReport: BOOL← (startPos = 0);  -- report if scavenging from beginning
BadFormat: PROC[s: ROPE] =
{ IF doReport THEN WalnutWindow.Report
   [IO.PutFR["Bad log file format at %g: %g", IO.int[logStream.GetIndex[]], IO.rope[s]]]
};

BEGIN ENABLE IO.EndOfStream =>
{BadFormat["Unexpected EOF"]; GOTO GiveUp};
existed: BOOL;
entryChar: CHAR;
entryLength, prefixLength, beginMsgPos: INT;
msgSetList: LIST OF Value← LIST[WalnutWindow.activeMsgSet];
logStream.SetIndex[startPos];
DO
-- Read *start* from log
[beginMsgPos, prefixLength, entryLength, entryChar]← ReadStartOfMsg[logStream, doReport];
IF entryLength = -1 THEN GOTO GiveUp;
IF (entryLength=0) OR (entryLength=prefixLength) AND
NOT (entryChar = '←) THEN EXIT;
-- Do delete, create, or message update to database
SELECT entryChar FROM
'← => -- mark message as read
[ , ]← ProcessHasBeenReadFromLog[logStream, prefixLength];
'+, '- => -- add or remove relship
BEGIN ENABLE DB.Error => IF code=NotFound THEN
{BadFormat["Illegal tag"]; CONTINUE};
foo, domainOrRelation: ROPE;
logStream.SetIndex[beginMsgPos+prefixLength];  -- ignore prefix info
[domainOrRelation, foo] ← TagAndValue[logStream, 2];
IF domainOrRelation.Equal["Domain"] THEN
-- Add or remove entity from domain foo
BEGIN domain: Domain;
entityName, tag: ROPE;
[tag, entityName]←TagAndValue[logStream, 2];
WalnutWindow.ReportRope[Rope.FromChar[entryChar]];
-- IfReporting[Rope.FromChar[entryChar], foo, ": ", entityName];
IF NOT tag.Equal["name"] THEN {BadFormat["expected name"]; RETURN[FALSE]};
domain← DeclareDomain[name: foo, segment: $Walnut, version: OldOnly];
IF entryChar = '- THEN
{e: Entity← DeclareEntity[domain, entityName, OldOnly];
IF e = NIL THEN {BadFormat[Rope.Cat[entityName, " doesn\'t exist!"]]; LOOP};
IF WalnutWindow.walnut # NIL THEN
WalnutWindow.DeleteMsgSetButton[e, entityName];
DestroyEntity[e]
}
ELSE IF entryChar = '+ THEN
IF foo.Equal["MsgSet"] THEN
{ new: BOOLTRUE;
ms: MsgSet;
ms← DB.DeclareEntity[domain, entityName, NewOnly ! DB.Error =>
  IF code=AlreadyExists THEN {new← FALSE; CONTINUE}];
IF new AND (WalnutWindow.walnut # NIL) THEN
  WalnutWindow.AddToMsgSetButtons[ms, entityName];
}
ELSE
{BadFormat["Only MsgSets should be added!"]; RETURN[FALSE]};
END
ELSE IF domainOrRelation.Equal["Relation"] THEN
-- Add or remove relship from relation foo.
-- We assume foo=mCategory
BEGIN ENABLE DB.Error =>
{BadFormat["Illegal tag"]; CONTINUE};
msgName, categoryName, tag: ROPE;
msg: Msg; msgSet: MsgSet;
IF NOT foo.Equal["mCategory"] THEN
{BadFormat["expected mCategory"]; RETURN[FALSE]};
[tag, msgName]← TagAndValue[logStream, 2];
IF NOT tag.Equal["of"] THEN {BadFormat["of?"]; RETURN[FALSE]};
msg← DeclareEntity[MsgDomain, msgName, OldOnly];
IF msg=NIL THEN {BadFormat[Rope.Cat[msgName, " doesn\'t exist!"]]; GOTO Fail};
[tag, categoryName]← TagAndValue[logStream, 2];
WalnutWindow.ReportRope[Rope.FromChar[entryChar]]; -- ***
-- IfReporting["Categorization: ", msgName, " in ", categoryName];
IF NOT tag.Equal["is"] THEN {BadFormat["is?"]; RETURN[FALSE]};
IF entryChar = '- THEN-- check if msgSet exists
{ msgSet← DeclareEntity[MsgSetDomain, categoryName, OldOnly];
IF msgSet # NIL THEN []← RemoveFrom[msg, msgSet, NIL, FALSE, FALSE]}
ELSE IF entryChar = '+ THEN-- create msgSet if it doesn't exist
{ msgSet← DeclareEntity[MsgSetDomain, categoryName];
[]← AddTo[msg, msgSet, FALSE]
};
EXITS Fail => logStream.SetIndex[beginMsgPos+entryLength-1]; -- next entry
END
ELSE -- domainOrRelation not Domain or Relation
{BadFormat["not domain or relation"]; RETURN[FALSE]};
-- Skip over the trailing CR
IF logStream.GetChar[]#'\n THEN BadFormat["Missing CR"];
END;
ENDCASE => -- regular message entry
BEGIN OPEN WalnutDB;
msgRec: MsgRec;
msgSet: MsgSet;
mL: LIST OF Value← NIL;
categoriesList: LIST OF ROPENIL;

[msgRec, existed, categoriesList]←
 GetMsgFromStream[logStream, prefixLength, entryLength-prefixLength, entryChar];
IF existed OR (msgRec.msg=NIL) THEN LOOP;
IF doReport THEN WalnutWindow.ReportRope["."];   -- adding message
IF categoriesList = NIL THEN mL← msgSetList
ELSE
FOR cL: LIST OF ROPE← categoriesList, cL.rest UNTIL cL = NIL DO
msgSet← DeclareEntity[MsgSetDomain, cL.first, OldOnly];
IF msgSet = NIL THEN
{ msgSet← DeclareEntity[MsgSetDomain, cL.first];
IF WalnutWindow.walnut # NIL THEN
 WalnutWindow.AddToMsgSetButtons[msgSet, cL.first];
};
[]← AddTo[msgRec.msg, msgSet, FALSE];  -- increments count as well
ENDLOOP;
END;
ENDLOOP;
RETURN[TRUE]
EXITS GiveUp =>   -- try to press on with what we have
{ RETURN[TRUE]}
END;
END;

ProcessHasBeenReadFromLog: PROC[logStream: IO.STREAM, prefixLength: INT]
  RETURNS[msg: Msg, existed: BOOL] =
BEGIN
 name: ROPE← RopeFromStream[logStream, prefixLength-minPrefixLength-1 ! IO.EndOfStream =>
   {WalnutWindow.Report["\nUnexpected EOF, ignoring HasBeenRead entry"]; GOTO eof}];
 rel: Relship;
 []← logStream.GetChar[];
 msg← DeclareEntity[d: MsgDomain, name: name, version: OldOnly];
IF msg = NIL THEN RETURN[msg, FALSE]; -- ignore
 rel← DB.SetP[msg, mHasBeenReadIs, B2V[TRUE]];
RETURN[msg, TRUE];
EXITS
  eof => RETURN;
END;

TRUSTED { TiogaCTRL← LOOPHOLE[1013B] };

END.