-- File: NutOpsImpl.mesa
-- Last edited by
-- Maxwell on: September 7, 1982 2:52 pm
-- Willie-Sue on: February 22, 1983 4:24 pm
-- Cattell on: July 28, 1983 10:37 am
-- Donahue, August 4, 1983 11:43 am


DIRECTORY
AlpineWalnutCmds USING[CopyForExpunge], Atom USING [MakeAtom], CommandTool, DB,
MBQueue, Process USING[Detach],
MessageWindow, Nut, NutOps, NutViewer, Rope, PrincOpsUtils, ViewerClasses;

NutOpsImpl: CEDAR MONITOR
IMPORTS AlpineWalnutCmds, CommandTool, DB, MessageWindow, NutViewer, Nut,
   Rope, PrincOpsUtils, Atom, MBQueue, Process
EXPORTS NutOps

= BEGIN OPEN DB;

Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;

-- generally useful DB routines

IsSystemDomain: PUBLIC PROC[ d: Domain ] RETURNS[ BOOLEAN ] = {
RETURN[ SELECT TRUE FROM
DB.Eq[d, DomainDomain] => TRUE,
DB.Eq[d, RelationDomain] => TRUE,
DB.Eq[d, DataTypeDomain] => TRUE,
DB.Eq[d, AttributeDomain] => TRUE,
DB.Eq[d, IndexDomain] => TRUE,
DB.Eq[d, IndexFactorDomain] => TRUE,
ENDCASE => FALSE ] };

IsSystemRelation: PUBLIC PROC[r: Relation] RETURNS[BOOLEAN] = {
RETURN[ SELECT TRUE FROM
DB.Eq[r, dSubType] => TRUE,
DB.Eq[r, aRelation] => TRUE,
DB.Eq[r, aType] => TRUE,
DB.Eq[r, aUniqueness] => TRUE,
DB.Eq[r, aLength] => TRUE,
DB.Eq[r, aLink] => TRUE,
DB.Eq[r, ifIndex] => TRUE,
DB.Eq[r, ifAttribute] => TRUE,
ENDCASE => FALSE ] };

AttributesOf: PUBLIC PROC[r: Relation] RETURNS[AttributeList] =
{IF Eq[r, dSubType] THEN RETURN[LIST[dSubTypeIs, dSubTypeOf]];
IF Eq[r, aRelation] THEN RETURN[LIST[aRelationOf, aRelationIs]];
IF Eq[r, aType] THEN RETURN[LIST[aTypeOf, aTypeIs]];
IF Eq[r, aUniqueness] THEN RETURN[LIST[aUniquenessOf, aUniquenessIs]];
IF Eq[r, aLength] THEN RETURN[LIST[aLengthOf, aLengthIs]];
IF Eq[r, aLink] THEN RETURN[LIST[aLinkOf, aLinkIs]];
IF Eq[r, ifIndex] THEN RETURN[LIST[ifIndexOf, ifIndexIs]];
IF Eq[r, ifAttribute] THEN RETURN[LIST[ifAttributeOf, ifAttributeIs]];
RETURN[VL2EL[GetPList[r, aRelationOf]]]};

FirstAttributeOf: PUBLIC PROC[r: Relation] RETURNS[Attribute] =
BEGIN es: AttributeList← VL2EL[GetPList[r, aRelationOf]];
IF es=NIL THEN RETURN[NIL] ELSE RETURN[es.first]
END;

EntityValued: PUBLIC PROC [a: Attribute] RETURNS[BOOL] =
BEGIN type: Entity;
IF a=NIL OR Null[a] THEN RETURN[FALSE];
type← V2E[GetP[a, aTypeIs]];
SELECT type FROM
IntType, RopeType, BoolType, RecordType, TimeType => RETURN[FALSE];
ENDCASE => RETURN[TRUE];
END;

GetUniquenessString: PUBLIC PROC[a: Attribute] RETURNS[ROPE] =
BEGIN u: Uniqueness;
IF Eq[a, dSubTypeIs] THEN RETURN["NonKey"];
IF Eq[a, dSubTypeOf] THEN RETURN["NonKey"];
IF Eq[a, aRelationOf] THEN RETURN["Key"];
IF Eq[a, aRelationIs] THEN RETURN["NonKey"];
IF Eq[a, aTypeOf] THEN RETURN["Key"];
IF Eq[a, aTypeIs] THEN RETURN["NonKey"];
IF Eq[a, aUniquenessOf] THEN RETURN["Key"];
IF Eq[a, aUniquenessIs] THEN RETURN["NonKey"];
IF Eq[a, aLengthOf] THEN RETURN["Key"];
IF Eq[a, aLengthIs] THEN RETURN["NonKey"];
IF Eq[a, aLinkOf] THEN RETURN["Key"];
IF Eq[a, aLinkIs] THEN RETURN["NonKey"];
IF Eq[a, ifIndexOf] THEN RETURN["Key"];
IF Eq[a, ifIndexIs] THEN RETURN["NonKey"];
IF Eq[a, ifAttributeOf] THEN RETURN["Key"];
IF Eq[a, ifAttributeIs] THEN RETURN["NonKey"];
u← V2U[GetP[a, aUniquenessIs]];
SELECT u FROM
Key => RETURN["Key"];
KeyPart => RETURN["KeyPart"];
None => RETURN["NonKey"];
OptionalKey => RETURN["OptionalKey"];
ENDCASE => RETURN["???"];
END;

GetTuples: PUBLIC PROC[e: Entity, a: Attribute] RETURNS [tl: LIST OF Relship] =
-- returns all the tuples that reference e in attribute a
{RETURN[RelshipSetToList[RelationSubset[GetRelation[a], LIST[[a, e]] ]]]};

GetRelation: PUBLIC PROC[a: Attribute] RETURNS[r: Relation] =
-- finds a's relation
{RETURN[V2E[GetP[a, aRelationIs]]]};

GetRefAttributes: PUBLIC PROC[d: Domain] RETURNS[al: LIST OF Attribute] =
-- returns all the attributes that can reference an entity from domain d
BEGIN
starRelation: Relation← DeclareRelation["*", SegmentOf[d]];
starOf: Attribute;
starIs: Attribute;
starList: LIST OF Attribute;
starOf ← DeclareAttribute[r: starRelation, name: "of", type: AnyDomainType, version: OldOnly
        ! DB.Error => CHECKED { starOf ← NIL; CONTINUE } ];
starIs ← DeclareAttribute[r: starRelation, name: "is", type: AnyDomainType, version: OldOnly
        ! DB.Error => CHECKED { starIs ← NIL; CONTINUE } ];
starList ← SELECT TRUE FROM
   starOf = NIL AND starIs = NIL => NIL,
   starIs = NIL => LIST[starOf],
   starOf = NIL => LIST[starIs],
   ENDCASE => LIST[starOf, starIs];
al← GetDomainRefAttributes[d];
al← AppendAttributes[al, starList];
END;

RemoveAttribute: PUBLIC PROC[a: Attribute, al: AttributeList] RETURNS[AttributeList] =
-- destructively removes a from al
BEGIN alLast: AttributeList← NIL;
FOR alT: AttributeList← al, alT.rest UNTIL alT=NIL DO
IF Eq[alT.first, a] THEN
IF alLast=NIL THEN RETURN[alT.rest] -- was first element
ELSE {alLast.rest← alT.rest; RETURN[al]}; -- was another element
alLast← alT;
ENDLOOP;
RETURN[al] -- not found
END;

AppendAttributes: PUBLIC PROC [al1, al2: AttributeList] RETURNS [al: AttributeList] =
BEGIN IF al1=NIL THEN RETURN [al2];
al← al1;
UNTIL al1.rest=NIL DO
al1← al1.rest ENDLOOP;
al1.rest← al2;
RETURN[al]
END;

RSetSize: PUBLIC PROC[rs: RelshipSet] RETURNS[INT] =
BEGIN
FOR size: INT IN [0..200) DO
IF Null[NextRelship[rs]] THEN
{ReleaseRelshipSet[rs]; RETURN[size]};
ENDLOOP;
ReleaseRelshipSet[rs];
RETURN[9999]; -- just tell 'im there are lots for now
END;

-- ***********************************************
AtomFromSegment: PUBLIC PROC[ segR: ROPE ] RETURNS[ ATOM ] = {
end: INT;
 begin: INT← Rope.Find[segR, ">"];
 IF begin < 0 THEN begin← Rope.Find[segR, "]" ] -- local file
 ELSE UNTIL (end← Rope.Find[segR, ">", begin+1])=-1 DO begin← end ENDLOOP; -- last one!
 end← Rope.Find[segR, ".", MAX[begin, 0] ];
 IF end < 0 THEN end← segR.Length[];
 begin ← MAX[ begin+1, 0 ];
 RETURN[Atom.MakeAtom[Rope.Substr[ segR, begin, (end-1)-begin+1]]] };
 
IsLocalName: PUBLIC PROC[ segR: ROPE ] RETURNS[ BOOL ] = {
IF Rope.Equal[Rope.Substr[base: segR, start: 0, len: 7], "[Local]"] THEN RETURN[TRUE];
RETURN[FALSE] };

SetUpSegment: PUBLIC PROC[
segmentFile: ROPE, seg: DB.Segment, number: NAT← 0, makeReadOnly: BOOL← FALSE ]
RETURNS [success: BOOL, readOnly: BOOL] =
TRUSTED {
-- A "foolproof" way to open a segment & transaction, regardless of whether
-- the segment is already declared, doesn't exist on the disk, or already has a transaction open.
-- Insures that AlpineUserImpls is loaded if segment is remote.
-- Whenever an abort or failure occurs, just gives up.
ENABLE DB.Aborted, DB.Failure => { success ← FALSE; CONTINUE };
alpineNeeded: BOOL← Rope.Find[segmentFile, "<"]#-1;
readOnly ← FALSE;
IF DB.TransactionOf[seg] # NIL THEN
{ success ← TRUE; readOnly← DB.GetSegmentInfo[seg].readOnly; RETURN};
IF alpineNeeded AND ~PrincOpsUtils.IsBound[AlpineWalnutCmds.CopyForExpunge] THEN {
err: ROPE;
NutViewer.Message[NIL, "Loading and starting AlpineUserImpls... "];
err ← CommandTool.Run["AlpineUserImpls"].errMsg;
IF err.Length[]#0 THEN {NutViewer.Message[NIL, err]; success ← FALSE; RETURN};
NutViewer.Message[NIL, "Done."]};
DB.DeclareSegment[segmentFile, seg, number, makeReadOnly, FALSE !
DB.Error => TRUSTED
{ IF code = CannotDefaultSegment THEN
NutViewer.Message[NIL, "Cypress doesn't know segment name!"];
success ← FALSE; GOTO AlreadyDone } ];
DB.OpenTransaction[seg ! DB.Error => TRUSTED
{ success← FALSE;
SELECT code FROM
FileNotFound =>
IF makeReadOnly THEN
{NutViewer.Message[NIL, "Segment not found!"]; GOTO AlreadyDone}
ELSE CONTINUE;
IllegalFileName =>
 {NutViewer.Message[NIL, "Illegal File Name!"]; GOTO AlreadyDone};
ProtectionViolation =>
IF makeReadOnly THEN
{ NutViewer.Message[NIL, "Segment protected!"]; GOTO AlreadyDone }
ELSE { readOnly ← TRUE; CONTINUE };
-- if NOT makeReadOnly then try again opening the segment readOnly
ENDCASE =>
{ NutViewer.Message[NIL, "Can't Open Transaction!"]; GOTO AlreadyDone } } ];
IF success THEN GOTO AlreadyDone;
IF readOnly THEN
{ -- Try opening it readonly now; give up on a failure
DB.CloseTransaction[DB.TransactionOf[seg]]; -- DB has left the transaction open
DB.DeclareSegment[segmentFile, seg, number, TRUE, FALSE];
success ← TRUE;
DB.OpenTransaction[seg ! DB.Error =>
TRUSTED{ SELECT code FROM
    ProtectionViolation =>
     { NutViewer.Message[NIL, "Segment protected!"]; GOTO AlreadyDone };
    ENDCASE => NutViewer.Message[NIL, "Can't Open Transaction!"];
    success ← FALSE;
    CONTINUE }];
IF NOT success THEN {DB.CloseTransaction[DB.TransactionOf[seg]]; GOTO AlreadyDone} }
ELSE -- this will probably make a new segment; don't use NewOnly just in case
{ DB.CloseTransaction[DB.TransactionOf[seg]]; -- DB has left the transaction open
DB.DeclareSegment[segmentFile, seg, number, readOnly, TRUE];
-- say NewOrOld just in case
success ← TRUE;
DB.OpenTransaction[seg ! DB.Error =>
TRUSTED{ IF code = ProtectionViolation THEN
    NutViewer.Message[NIL, "Can't write on segment!"]
    ELSE NutViewer.Message[NIL, "Can't Open Transaction!"];
    success ← FALSE; CONTINUE }];
IF NOT success THEN {DB.CloseTransaction[DB.TransactionOf[seg]]; GOTO AlreadyDone};
DB.MarkTransaction[DB.TransactionOf[seg]] }; -- make sure segment initializated if abort
NutViewer.Message[NIL, "Done."]
EXITS
AlreadyDone => NULL };


TryRestart: PUBLIC PROC[trans: DB.Transaction] = {
-- Attempts to re-open an aborted transaction if user confirms.
-- will also call any registered notification procedures to reinitialize DB variables
segment: DB.Segment = GetSegment[trans];
fileName: ROPE = DB.GetSegmentInfo[segment].filePath;
confirmed, success: BOOL;
{ ENABLE DB.Failure =>
  { SELECT what FROM
    $communication => NutViewer.Error[NIL, "Can't open Alpine server"];
    $serverBusy => NutViewer.Error[NIL, "Alpine server too busy"];
    $lockConflict => NutViewer.Error[NIL, "Alpine can't open file"];
  ENDCASE => NutViewer.Error[NIL, "Alpine problem"];
   Nut.Notify[segment, close]; CONTINUE };
MessageWindow.Blink[];
MessageWindow.Clear[];
MessageWindow.Append["Transaction aborted! Please confirm, to try re-opening"];
-- see if the user wants to continue with this
confirmed ← MessageWindow.Confirm[];
IF NOT confirmed THEN
{MessageWindow.Append["... not re-opened."];
Nut.Notify[segment, close]; RETURN};
MessageWindow.Append["... "];
DB.AbortTransaction[trans];
-- now try to open the transaction
success ← FALSE;
FOR i: INT IN [0..5) WHILE NOT success DO
DB.OpenTransaction[segment !
   DB.Aborted => LOOP;
     DB.Error => IF code = TransactionAlreadyOpen THEN CONTINUE];
success ← TRUE
ENDLOOP;
IF NOT success THEN
TRUSTED{
MessageWindow.Append["transaction could not be reopened"];
Process.Detach[ FORK Nut.Notify[segment, close] ];
RETURN };
-- let all the nuts redisplay themselves (this may take some time)
TRUSTED {Process.Detach[ FORK Nut.Notify[segment, abort] ]};
MessageWindow.Append["done."] } };

Do: PUBLIC PROC[
proc: PROC[ REF ANY ], clientData: REF ANY ← NIL,
reTry: BOOL ← FALSE, msgViewer: Viewer ← NIL ] RETURNS [succeeded: BOOL] = {
-- All catches of database signals should go through this procedure, to
-- simplify error recovery throughout Squirrel and other applications.
ENABLE BEGIN
DB.Error => {
succeeded← FALSE;
SELECT code FROM
NullifiedArgument =>
{NutViewer.Message[msgViewer, "Entity has been nullified."]; CONTINUE};
TransactionNotOpen =>
{NutViewer.Message[msgViewer, "There is no transaction open!"]; CONTINUE};
BadUserPassword =>
{NutViewer.Message[msgViewer, "Bad alpine user/password!"]; CONTINUE};
ProtectionViolation =>
{NutViewer.Message[msgViewer, "Alpine segment protected!"]; CONTINUE};
QuotaExceeded =>
{NutViewer.Message[msgViewer, "Alpine quota exceeded!"]; CONTINUE};
WriteNotAllowed =>
{NutViewer.Message[msgViewer, "Attempt to write read-only segment."]; CONTINUE};
ENDCASE => NULL;
};
DB.Failure => TRUSTED {
succeeded← FALSE;
MBQueue.Flush[NutViewer.DBQueue[]];
SELECT what FROM
$communication => NutViewer.Error[msgViewer, "Can't open Alpine server"];
$serverBusy => NutViewer.Error[msgViewer, "Alpine server too busy"];
$lockConflict => NutViewer.Error[msgViewer, "Alpine can't open file"];
ENDCASE => NutViewer.Error[msgViewer, "Alpine problem"];
Process.Detach[FORK Nut.Notify[NIL, close]];
CONTINUE
};
DB.Aborted => TRUSTED {
succeeded← FALSE; Process.Detach[FORK TryRestart[trans]]; CONTINUE};
END;
p: SAFE PROCESS ← NIL;
succeeded← TRUE;
proc[clientData ! DB.Aborted => TRUSTED { IF reTry THEN {
MBQueue.Flush[NutViewer.DBQueue[]];
p ← FORK TryRestart[trans]; CONTINUE } ELSE REJECT } ];
IF p = NIL THEN RETURN; -- NOTHING WENT WRONG!!
TRUSTED {JOIN p};
proc[clientData] -- don't bother trying to restart here -- };

GetSegment: PROC [t: DB.Transaction] RETURNS [seg: DB.Segment] = {
-- Finds the first database segment associated with segment t.
-- Note we assume all applications have only one segment per transaction right now.
segs: LIST OF DB.Segment← DB.GetSegments[];
FOR segs← segs, segs.rest UNTIL segs=NIL DO
IF DB.TransactionOf[segs.first]=t THEN RETURN[segs.first] ENDLOOP;
RETURN[NIL]
};

END.

Changes since October 82:

Cattell October 13, 1982 9:28 am: Save and Reset buttons should Fork.

Cattell December 1, 1982 4:29 pm: Should call GetRope instead of GetToken for 2nd DBShow argument.

Cattell June 22, 1983 5:08 pm: