-- 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 Atom USING [MakeAtom], DB, MBQueue, Process USING[Detach], MessageWindow, Nut, NutOps, NutViewer, Rope, PrincOpsUtils, ViewerClasses; NutOpsImpl: CEDAR MONITOR IMPORTS 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 }; 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 => { 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: