-- 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
 --  Widom, June 17, 1984 8:20:03 pm PDT
 --  Butler, June 26, 1984 5:13:55 pm PDT

DIRECTORY
  Atom USING [MakeAtom],
  DB,
  DBEnvironment,
  MBQueue,
  Process USING[Detach],
  MessageWindow, 
  NutOps, 
  NutViewer USING[DBQueue, Error, Message],
  Rope, 
  PrincOpsUtils,
  ViewerClasses;

NutOpsImpl: CEDAR MONITOR
  IMPORTS DB, DBEnvironment, MessageWindow, NutViewer, NutOps,
            Rope, PrincOpsUtils, Atom, MBQueue, Process
  EXPORTS NutOps
    
  = BEGIN OPEN DB;
  
  Viewer: TYPE = ViewerClasses.Viewer; 
  ROPE: TYPE = Rope.ROPE;
  Separator: PUBLIC CHAR _ '!;
  Sep: ROPE = Rope.FromChar[Separator]; 
  
-- 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 ] };

                 
IsSystemEntity: PUBLIC PROC[e: Entity] RETURNS[BOOLEAN] =
BEGIN
eName: ROPE = NutOps.SafeNameOf[e];
IF Rope.Equal[eName, "Attribute", FALSE] OR Rope.Equal[eName, "DataType", FALSE]
OR Rope.Equal[eName, "Domain", FALSE] OR Rope.Equal[eName, "Relation", FALSE]
THEN RETURN[TRUE]
ELSE RETURN[FALSE];
END;



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["*", SafeSegmentOf[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 };
   readOnly _ FALSE;
    IF DB.TransactionOf[seg] # NIL THEN
      { success _ TRUE; readOnly_ DB.GetSegmentInfo[seg].readOnly; RETURN};
    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 => TRUSTED
          { 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"];
                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."];
       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"];
       RETURN };
    } };

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 => TRUSTED {
        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"];
          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]
   };

SafeNameOf: PUBLIC PROC[e: Entity] RETURNS [s: ROPE] =
BEGIN
IF e=NIL THEN RETURN["NEW"] ELSE RETURN [ DB.NameOf[e] ]
END;

SafeSegmentOf: PUBLIC PROC[e: EntityOrRelship] RETURNS [s: Segment] =
BEGIN
IF e=NIL THEN RETURN[NIL] ELSE RETURN [ DB.SegmentOf[e] ]
END;

SafeDomainOf: PUBLIC PROC[e: Entity] RETURNS [s: Domain] =
BEGIN
IF e=NIL THEN RETURN[NIL] ELSE RETURN [ DB.DomainOf[e] ]
END;

EntityToName: PUBLIC PROC[ e: Entity, seg: DB.Segment _ NIL ] RETURNS[ name: ROPE ] = {
    IF NOT NutOps.IsSystemDomain[d: DomainOf[e]] THEN seg _ DB.SegmentOf[e];
    name _ Rope.Cat[ DB.GetSegmentInfo[seg].filePath,
                           Sep, NameOf[DomainOf[e]], Sep, NameOf[e] ]};
                           
  MakeName: PUBLIC PROC[seg: DB.Segment, d: Domain, eName: ROPE] RETURNS[name: ROPE] =
  { name _ Rope.Cat[GetSegmentInfo[seg].filePath, Sep, NameOf[d], Sep, eName]};
  
  NameToEntity: PUBLIC PROC[name: ROPE, create: BOOL _ FALSE] RETURNS[e: Entity] = {
    segName, domainName, entityName: ROPE;
    domain: Domain;
    segment: DB.Segment;
    [segName, domainName, entityName] _ DecomposeName[name];
    segment _ NutOps.AtomFromSegment[segName];
    -- check to make sure that this is the right segment for the entity
    IF NOT Rope.Equal[DB.GetSegmentInfo[segment].filePath, segName, FALSE]
        THEN RETURN[NIL];
    domain _ DeclareDomain[ domainName, segment, Version[OldOnly] ! 
                 DBEnvironment.Error => CHECKED { domain _ NIL; CONTINUE } ];
    e _ IF domain = NIL THEN NIL
         ELSE FetchEntity[ domain, entityName, segment ];
    IF e = NIL AND domain # NIL AND create THEN
      e _ DeclareEntity[ domain, entityName ! DB.Error => CONTINUE ] };
                
  SegmentOf: PUBLIC PROC[ name: ROPE ] RETURNS[ segment: DB.Segment ] = {
    segNameLength: INT = Rope.Find[name, Sep];
    segName: ROPE = Rope.Substr[name, 0, segNameLength];
    RETURN[ NutOps.AtomFromSegment[ segName ] ] };
  
  DecomposeName: PUBLIC PROC[ name: ROPE ] RETURNS[ segment, domain, entity: ROPE ] =
     BEGIN
     segNameLength: INT = Rope.Find[ name, Sep ];
     domainNameLength: INT = Rope.Find[ name, Sep, segNameLength+1 ] - segNameLength - 1;
     segment_ Rope.Substr[ name, 0, segNameLength ];
     domain_ Rope.Substr[ name, segNameLength+1, domainNameLength ];
     entity_ Rope.Substr[ name, segNameLength+domainNameLength+2 ];
     END;


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: 

Butler June 26, 1984:
Updated to comply with new organization of Nut and Squirrel