File: DBToolsImpl.mesa
Last Edited by: Donahue, January 3, 1985 10:51:31 am PST
(Simplified substantially to handle only those tools that are considered part of the current release)
(Changed ticksToWait to 60 -- closes transactions more rapidly now)
Last Edited by: Widom, August 22, 1984 11:20:36 am PDT
Last Edited by: Winkler, May 24, 1985 11:48:55 am PDT
DIRECTORY
Atom USING [MakeAtom, GetPName],
Commander,
CommandTool,
DBTools,
FS,
Booting USING [CheckpointProc, RegisterProcs, RollbackProc],
Convert USING[RopeFromRope],
DB,
IO,
IOClasses,
TextFind,
MessageWindow USING [Append],
Process USING[Ticks, SecondsToTicks, Detach, Pause],
Rope USING [Cat, Equal, Substr, ROPE, Length, Concat],
UserProfile USING [Token, ProfileChangedProc, CallWhenProfileChanges],
UserCredentials USING[CredentialsChangeProc],
ViewerClasses
;
DBToolsImpl: CEDAR MONITOR
IMPORTS Atom, Booting, CommandTool, Convert, FS, IO, IOClasses, MessageWindow, Process, Rope, DB, TextFind, UserProfile
EXPORTS DBTools
=
BEGIN
OPEN DB, IO, Rope;
Types
ROPE: TYPE = Rope.ROPE;
Global variables for accessing the database
toolDomain: DB.Domain; -- the domain of tools
Tools have the following properties (each property is a rope). What is given below are the indices into the propertyTable which contains the names and DB.Attributes for each of the properties
loadFileProp: [0..6) = 0; -- the .load file for the tool
docFileProp: [0..6) = 1; -- the documentation file for the tool
briefDocProp: [0..6) = 2; -- a brief description of the tool
viewerFlavorProp: [0..6) = 3; -- the registered viewer flavor for the tool
namePatternProp: [0..6) = 4; -- the name pattern for the tool
argumentPatternProp: [0..6) = 5; -- the argument pattern for the tool
PropertyRecord: TYPE = RECORD[name: ROPE, prop: DB.Attribute ← NIL];
propertyTable: ARRAY[0..6) OF PropertyRecord ←
[[name: "LoadFile"], [name: "DocFile"], [name: "BriefDoc"], [name: "ViewerFlavor"], [name: "NamePattern"], [name: "ArgumentPattern"]];
-- a list consisting of all of the properties given above
flavorRelation:
DB.Relation;
-- the relation corresponding to the flavor property
flavorOf: DB.Attribute; -- the "of" attribute of the flavor relation (the "is" attribute is the viewerFlavorProp)
descriptorRelation:
DB.Relation;
-- the description of tools
descriptorOf: DB.Attribute; -- a tool
descriptorIs: DB.Attribute; -- is a ROPE
ToolDB: PUBLIC ROPE ← NIL;
pendingChange: BOOL ← FALSE; -- this is set by the rollback and credentials change procs to remember a potential change of state; it is checked by CarefullyApply, which will call ResetSchema if it is true
toolTrans: DB.Transaction ← NIL;
readOnly: PUBLIC BOOLEAN ← TRUE; -- true if the segment is readonly
activity: BOOLEAN ← FALSE; -- true if a database operation has been performed recently
ticksToWait: Process.Ticks ← Process.SecondsToTicks[60];
transOpened: CONDITION;
LoadError: ERROR = CODE;
loadedList: LIST OF ROPE ← NIL; -- a list of all of the loads performed
Establishing the database
EstablishToolDB:
PUBLIC
ENTRY
PROC [file: Rope.
ROPE ←
NIL] = {
ENABLE UNWIND => NULL;
ToolDB ←
IF file =
NIL
THEN
UserProfile.Token[key: "Tool.Segment", default: "[Luther.Alpine]<CedarDoc>Tool.Segment"] ELSE file;
pendingChange ← TRUE };
WatchDBActivity:
PROC[] = {
WHILE
TRUE
DO
Process.Pause[ticksToWait];
CheckConnection[]
ENDLOOP
};
CheckConnection:
ENTRY
PROC[] = {
ENABLE UNWIND => NULL;
IF
NOT activity
THEN {
CloseTransaction[]; -- don't keep the connection open too long
WAIT transOpened };
activity ← FALSE;
};
Close: PUBLIC ENTRY PROC [] = { CloseTransaction[] };
CloseTransaction:
INTERNAL
PROC [] = {
caughtAborted: BOOL ← FALSE;
IF toolTrans #
NIL
THEN
DB.CloseTransaction[toolTrans ! DB.Aborted => { caughtAborted ← TRUE; CONTINUE }];
IF caughtAborted THEN DB.AbortTransaction[toolTrans];
toolTrans ← NIL };
Accessing Tools
RegisterTool:
PUBLIC
ENTRY
PROC [toolName, loadFile:
ROPE] ~ {
ENABLE UNWIND => NULL;
IF InternalRegisterTool[toolName: toolName, loadFile: loadFile]
THEN DB.MarkTransaction[toolTrans]
ELSE MessageWindow.Append["Can not register tool."]};
InternalRegisterTool:
INTERNAL
PROC[toolName:
ROPE, loadFile, docFile, briefDoc:
ROPE ←
NIL, descriptors:
LIST
OF
ROPE ←
NIL]
RETURNS[success:
BOOLEAN] = {
ENABLE UNWIND => NULL;
DoRegisterTool:
PROC[] = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
IF loadFile #
NIL
THEN [] ← SetP[toolEntity, propertyTable[loadFileProp].prop, S2V[loadFile]];
IF docFile #
NIL
THEN [] ← SetP[toolEntity, propertyTable[docFileProp].prop, S2V[docFile]];
IF briefDoc #
NIL
THEN [] ← SetP[toolEntity, propertyTable[briefDocProp].prop, S2V[briefDoc]];
now set all of the descriptors for the tool
IF descriptors = NIL THEN RETURN;
BEGIN
first throw away all of the old ones
toolAttrValue: DB.AttributeValue = [descriptorOf, toolEntity];
oldrships: RelshipSet = RelationSubset[descriptorRelation, LIST[toolAttrValue]];
FOR old:
DB.Relship ← NextRelship[oldrships], NextRelship[oldrships]
UNTIL old =
NIL
DO
DB.DestroyRelship[old]
ENDLOOP;
DB.ReleaseRelshipSet[oldrships];
now add the new ones
FOR ds:
LIST
OF
ROPE ← descriptors, ds.rest
WHILE ds #
NIL
DO
newDescrValue: DB.AttributeValue = [descriptorIs, S2V[descriptors.first]];
[] ← DeclareRelship[descriptorRelation, LIST[toolAttrValue, newDescrValue]]
ENDLOOP
END };
IF readOnly
OR ToolDB =
NIL
OR toolName =
NIL
THEN {
IF readOnly THEN MessageWindow.Append["File is read only."]
ELSE
IF ToolDB =
NIL
THEN MessageWindow.Append["ToolDB is
NIL."]
ELSE MessageWindow.Append["toolName is NIL."];
RETURN; -- nothing to do
};
success ← CarefullyApply[DoRegisterTool]
};
GetLoadFile:
PUBLIC
ENTRY
PROC [toolName:
ROPE]
RETURNS [loadFile:
ROPE] ~ {
ENABLE UNWIND => NULL;
[loadFile ~ loadFile] ← InternalGetToolProps[toolName]
};
InternalGetToolProps:
INTERNAL
PROC [toolName:
ROPE]
RETURNS [loadFile, docFile, briefDoc:
ROPE] ~ {
ENABLE UNWIND => NULL;
DoGetToolInfo:
PROC[] = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
toolAttrValue: DB.AttributeValue = [descriptorOf, toolEntity];
IF toolEntity = NIL THEN RETURN;
loadFile ← V2S[GetP[toolEntity, propertyTable[loadFileProp].prop]];
docFile ← V2S[GetP[toolEntity, propertyTable[docFileProp].prop]];
briefDoc ← V2S[GetP[toolEntity, propertyTable[briefDocProp].prop]] };
IF NOT CarefullyApply[DoGetToolInfo] THEN RETURN[NIL, NIL, NIL]
};
GetToolDocumentation:
PUBLIC
ENTRY
PROC [toolName:
ROPE]
RETURNS [docFile, briefDoc:
ROPE] ~ {
ENABLE UNWIND => NULL;
[docFile ~ docFile, briefDoc ~ briefDoc] ← InternalGetToolProps[toolName]
};
SetToolDocumentation:
PUBLIC
ENTRY
PROC [toolName:
ROPE, docFile, briefDoc:
ROPE ←
NIL] ~ {
ENABLE UNWIND => NULL;
IF InternalRegisterTool[toolName: toolName, docFile: docFile, briefDoc: briefDoc] THEN DB.MarkTransaction[toolTrans]
};
SetToolDescriptors:
PUBLIC
ENTRY
PROC[toolName:
ROPE, descriptors:
LIST
OF
ROPE ←
NIL] = {
ENABLE UNWIND => NULL;
DoSetDescriptors:
PROC[] = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
IF descriptors = NIL THEN RETURN;
BEGIN
first throw away all of the old ones
toolAttrValue: DB.AttributeValue = [descriptorOf, toolEntity];
oldrships: RelshipSet = RelationSubset[descriptorRelation, LIST[toolAttrValue]];
FOR old:
DB.Relship ← NextRelship[oldrships], NextRelship[oldrships]
UNTIL old =
NIL
DO
DB.DestroyRelship[old]
ENDLOOP;
DB.ReleaseRelshipSet[oldrships];
now add the new ones
FOR ds:
LIST
OF
ROPE ← descriptors, ds.rest
WHILE ds #
NIL
DO
newDescrValue: DB.AttributeValue = [descriptorIs, S2V[ds.first]];
[] ← DeclareRelship[descriptorRelation, LIST[toolAttrValue, newDescrValue]]
ENDLOOP
END };
IF readOnly OR ToolDB = NIL OR toolName = NIL THEN RETURN; -- nothing to do
IF CarefullyApply[DoSetDescriptors] THEN DB.MarkTransaction[toolTrans]
};
GetToolDescriptors:
PUBLIC ENTRY PROC[toolName:
ROPE]
RETURNS[descriptors:
LIST
OF
ROPE] = {
DoGetToolDescriptors:
PROC[] = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
toolAttrValue: DB.AttributeValue = [descriptorOf, toolEntity];
IF toolEntity = NIL THEN RETURN;
BEGIN
toolAttrValue: DB.AttributeValue = [descriptorOf, toolEntity];
rships: RelshipSet = RelationSubset[descriptorRelation, LIST[toolAttrValue]];
FOR old:
DB.Relship ← NextRelship[rships], NextRelship[rships]
UNTIL old =
NIL
DO
descriptors ← CONS[V2S[DB.GetF[old, descriptorIs]], descriptors]
ENDLOOP;
DB.ReleaseRelshipSet[rships];
END };
IF NOT CarefullyApply[DoGetToolDescriptors] THEN RETURN[NIL]
};
FindMatchingTools:
PUBLIC
ENTRY
PROC [descriptors:
LIST
OF
ROPE]
RETURNS [tools:
LIST
OF
ROPE] ~ {
ENABLE UNWIND => NULL;
DoFindMatch:
PROC[] = {
entityList, newList: LIST OF DB.Entity ← NIL;
descriptorList: LIST OF DB.AttributeValue ← NIL;
rshipSet: DB.RelshipSet;
IF descriptors =
NIL
THEN {
-- produce the list of all of the tools in the database
toolList: LIST OF DB.Entity = DB.EntitySetToList[DB.DomainSubset[toolDomain]];
FOR tl:
LIST
OF
DB.Entity ← toolList, tl.rest
UNTIL tl =
NIL
DO
tools ← CONS[DB.NameOf[tl.first], tools]
ENDLOOP;
RETURN };
compute the list of attribute/value pairs
FOR desc:
LIST
OF
ROPE ← descriptors, desc.rest
UNTIL desc =
NIL
DO
descriptorList ← CONS[AttributeValue[descriptorIs, S2V[desc.first]], descriptorList]
ENDLOOP;
now, compute the list of entities matching the first descriptor
rshipSet ← RelationSubset[ descriptorRelation, LIST[descriptorList.first]];
descriptorList ← descriptorList.rest;
FOR rs:
DB.Relship ← NextRelship[rshipSet], NextRelship[rshipSet]
UNTIL rs =
NIL
DO
entityList ← CONS[V2E[GetF[rs, descriptorIs]], entityList]
ENDLOOP;
ReleaseRelshipSet[rshipSet];
reduce the list of entities by seeing which of them also have relationships with the remaining descriptors
FOR desc:
LIST
OF
ROPE ← descriptors, desc.rest
UNTIL desc =
NIL
DO
descrAttrValue: DB.AttributeValue = [descriptorIs, desc.first];
FOR eL:
LIST
OF
DB.Entity ← entityList, eL.rest
UNTIL eL =
NIL
DO
toolAttrValue: DB.AttributeValue = [descriptorOf, eL.first];
IF DeclareRelship[descriptorRelation, LIST[toolAttrValue, descrAttrValue], OldOnly] # NIL THEN newList ← CONS[eL.first, newList]
ENDLOOP;
entityList ← newList; newList ← NIL
ENDLOOP;
return the names of all of the entities remaining on the NewList
FOR eL:
LIST
OF Entity ← entityList, eL.rest
UNTIL eL =
NIL
DO
tools ← CONS[DB.NameOf[eL.first], tools]
ENDLOOP };
IF NOT CarefullyApply[DoFindMatch] THEN RETURN[NIL]
};
InternalLoadTool:
INTERNAL
PROC [toolName:
ROPE, errorStream:
IO.
STREAM ←
IO.noWhereStream] ~ {
loadFile: ROPE = InternalGetToolProps[toolName].loadFile;
command: ROPE;
IF loadFile = NIL THEN RETURN;
command ← Rope.Cat["Source ///Commands/", loadFile, "\n"];
InternalDoLoad[toolName, command, errorStream];
};
InternalDoLoad:
INTERNAL PROC[toolName, commandLine:
ROPE, errorStream:
IO.
STREAM ←
IO.noWhereStream] = {
DoCommand[commandLine, errorStream];
InternalAddLoaded[toolName] };
LoadTool:
PUBLIC
ENTRY
PROC [toolName:
ROPE, errorStream:
IO.
STREAM ←
IO.noWhereStream] ~ {
ENABLE UNWIND => NULL;
IF NOT CheckLoaded[toolName] THEN InternalLoadTool[toolName, errorStream]
};
AddLoaded: ENTRY PROC [tool: ROPE] ~ { InternalAddLoaded[tool] };
InternalAddLoaded: INTERNAL PROC [tool: ROPE] ~ { loadedList ← CONS[tool, loadedList] };
CheckLoaded:
PROC [tool:
ROPE]
RETURNS [yes:
BOOLEAN] ~ {
yes ← FALSE;
FOR loaded:
LIST
OF
ROPE ← loadedList, loaded.rest
UNTIL loaded =
NIL
DO
IF Rope.Equal[loaded.first, tool] THEN RETURN[TRUE]
ENDLOOP
};
ApplyTool:
PUBLIC
ENTRY
PROC [toolName, arguments:
ROPE, errorStream:
IO.
STREAM ←
IO.noWhereStream] ~ {
loadFile: ROPE = InternalGetToolProps[toolName].loadFile;
command: ROPE;
IF Rope.Equal[loadFile, ""] AND DB.DeclareEntity[toolDomain, toolName, OldOnly] = NIL THEN RETURN; -- if these are true, then the tool isn't even registered (it may not have a load file if the tools is part of LifeSupport)
IF
NOT Rope.Equal[loadFile, ""]
THEN {
-- load the .load file from ///Commands
InternalLoadTool[toolName, errorStream];
command ← Rope.Concat["///Commands/", toolName] }
ELSE command ← toolName;
IF arguments # NIL THEN command ← Rope.Cat[command, " ", arguments, "\n"]
ELSE command ← Rope.Concat[command, "\n"];
TRUSTED {Process.Detach[ FORK DoCommand[command, errorStream] ] }
};
DoCommand:
PROC[commandLine:
ROPE, errorStream:
IO.
STREAM ←
IO.noWhereStream] = {
cmdHandle: Commander.Handle = NEW[Commander.CommandObject ← []];
cmdHandle.err ← errorStream;
cmdHandle.out ← IO.noWhereStream;
[] ← CommandTool.DoCommandRope[commandLine: commandLine, parent: cmdHandle] };
RegisterViewerFlavor:
PUBLIC
ENTRY
PROC [tool:
ROPE, flavor: ViewerClasses.ViewerFlavor] ~ {
ENABLE UNWIND => NULL;
DoRegisterViewerFlavor:
PROC = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, tool, OldOnly];
atomName: Rope.ROPE = IF flavor = NIL THEN NIL ELSE Atom.GetPName[flavor];
IF toolEntity = NIL THEN RETURN;
[] ← SetP[toolEntity, propertyTable[viewerFlavorProp].prop, S2V[atomName]] };
IF CarefullyApply[DoRegisterViewerFlavor] THEN DB.MarkTransaction[toolTrans]
};
RegisterNamePattern:
PUBLIC
ENTRY
PROC [toolName:
ROPE, pattern:
ROPE] ~ {
ENABLE UNWIND => NULL;
DoRegisterNamePattern:
PROC = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName, OldOnly];
IF toolEntity = NIL THEN RETURN;
[] ← SetP[toolEntity, propertyTable[namePatternProp].prop, S2V[pattern]] };
IF CarefullyApply[DoRegisterNamePattern] THEN DB.MarkTransaction[toolTrans]
};
RegisterArgumentPattern:
PUBLIC
ENTRY
PROC [toolName:
ROPE, pattern:
ROPE] ~ {
ENABLE UNWIND => NULL;
DoRegisterArgumentPattern:
PROC = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName, OldOnly];
IF toolEntity = NIL THEN RETURN;
[] ← SetP[toolEntity, propertyTable[argumentPatternProp].prop, S2V[pattern]] };
IF CarefullyApply[DoRegisterArgumentPattern] THEN DB.MarkTransaction[toolTrans]
};
GetViewerInfo:
PUBLIC
ENTRY
PROC [toolName:
ROPE]
RETURNS [flavor: ViewerClasses.ViewerFlavor, namePattern, argumentPattern:
ROPE] ~ {
ENABLE UNWIND => NULL;
[flavor, namePattern, argumentPattern] ← InternalGetViewerInfo[toolName]
};
InternalGetViewerInfo:
INTERNAL
PROC [toolName:
ROPE]
RETURNS [flavor: ViewerClasses.ViewerFlavor, namePattern, argumentPattern:
ROPE] ~ {
ENABLE UNWIND => NULL;
DoGetToolInfo:
PROC[] = {
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
IF toolEntity = NIL THEN RETURN;
flavor ← Atom.MakeAtom[V2S[GetP[toolEntity, propertyTable[viewerFlavorProp].prop]]];
namePattern ← V2S[GetP[toolEntity, propertyTable[namePatternProp].prop]];
argumentPattern ← V2S[GetP[toolEntity, propertyTable[argumentPatternProp].prop]] };
IF NOT CarefullyApply[DoGetToolInfo] THEN RETURN[NIL, NIL, NIL]
};
ViewerToTool:
PUBLIC
ENTRY
PROC [v: ViewerClasses.Viewer]
RETURNS [toolName:
ROPE, arguments:
ROPE] ~ {
ENABLE UNWIND => NULL;
DoViewerTool:
PROC = {
viewerName: ROPE = v.name;
flavor: ROPE = Atom.GetPName[v.class.flavor];
flavorAttrValue: DB.AttributeValue = [propertyTable[viewerFlavorProp].prop, S2V[flavor]];
toolSet: DB.RelshipSet = RelationSubset[flavorRelation, LIST[flavorAttrValue]];
toolRelation: DB.Relship ← NextRelship[toolSet];
toolEntity: DB.Entity ← IF toolRelation = NIL THEN NIL ELSE V2E[GetF[toolRelation, flavorOf]];
ReleaseRelshipSet[toolSet];
IF toolEntity =
NIL
THEN
BEGIN
toolSet: DB.EntitySet = DomainSubset[toolDomain];
FOR tool:
DB.Entity ← NextEntity[toolSet], NextEntity[toolSet]
UNTIL tool =
NIL
DO
namePattern: ROPE = V2S[GetP[tool, propertyTable[namePatternProp].prop]];
pattern: TextFind.Finder = TextFind.CreateFromRope[namePattern];
found: BOOLEAN;
after, before: TextFind.Offset;
[found ~ found, after ~ after, before ~ before] ← TextFind.SearchRope[pattern, viewerName];
IF found
AND (before = 0)
AND (after = viewerName.Length[])
THEN
{toolEntity ← tool; EXIT}
ENDLOOP;
ReleaseEntitySet[toolSet];
IF toolEntity = NIL THEN { toolName ← NIL; arguments ← NIL; RETURN }
END;
BEGIN
argPattern: ROPE = V2S[GetP[toolEntity, propertyTable[argumentPatternProp].prop]];
pattern: TextFind.Finder = TextFind.CreateFromRope[argPattern];
found: BOOLEAN;
at, atEnd: TextFind.Offset;
[found ~ found, at ~ at, atEnd ~ atEnd] ← TextFind.SearchRope[pattern, viewerName];
IF found THEN arguments ← Rope.Substr[viewerName, at, atEnd-at];
toolName ← DB.NameOf[toolEntity]
END };
IF NOT CarefullyApply[DoViewerTool] THEN RETURN[NIL, NIL]
};
Parsing Tool Catalogues
stream: IO.STREAM; -- the stream used either by Parse to read a catalogue or by WriteCatalogue to print one
Parse:
INTERNAL
PROCEDURE[] = {
ENABLE IO.EndOfStream, IO.Error => TRUSTED{ ERROR LoadError };
DO
toolName: ROPE = IO.GetTokenRope[stream ! IO.EndOfStream => GOTO Done].token;
toolEntity: DB.Entity = DeclareEntity[toolDomain, toolName];
ofValue: DB.AttributeValue = [descriptorOf, toolEntity];
FOR i: [0..6)
IN [0..6)
DO
propertyName: Rope.ROPE = stream.GetID[];
propertyValue: Rope.ROPE = stream.GetRopeLiteral[];
FOR j: [0..6)
IN [0..6)
DO
IF Rope.Equal[propertyTable[j].name, propertyName]
THEN
{[] ← DB.SetP[toolEntity, propertyTable[j].prop, S2V[propertyValue]]; EXIT}
ENDLOOP;
ENDLOOP;
IF NOT Rope.Equal[stream.GetTokenRope[].token, "("] THEN ERROR LoadError;
DO
token: ROPE;
token ← IO.GetCedarTokenRope[stream].token;
IF Rope.Equal[token,")"] THEN EXIT;
[] ← DeclareRelship[descriptorRelation, LIST[ofValue, AttributeValue[descriptorIs, S2V[token]]]]
ENDLOOP
ENDLOOP;
EXITS
Done => stream.Close[];
};
InternalWrite:
INTERNAL
PROC[] = {
tools: DB.EntitySet = DB.DomainSubset[toolDomain];
FOR tool:
DB.Entity ← NextEntity[tools], NextEntity[tools]
UNTIL tool =
NIL
DO
OPEN IO;
stream.PutF["\n %g", rope[DB.NameOf[tool]]];
FOR i: [0..6)
IN [0..6)
DO
stream.PutF["\n %g %g ", rope[propertyTable[i].name], rope[Convert.RopeFromRope[V2S[GetP[tool, propertyTable[i].prop]]]]]
ENDLOOP;
BEGIN
descrAttrValue: DB.AttributeValue = [descriptorOf, tool];
descRships: DB.RelshipSet = DB.RelationSubset[descriptorRelation, LIST[descrAttrValue]];
stream.Put[rope[" ( "]];
FOR descr:
DB.Relship ← NextRelship[descRships], NextRelship[descRships]
UNTIL descr =
NIL
DO
descriptor: ROPE = V2S[GetF[descr, descriptorIs]];
stream.PutF[" %g", rope[Convert.RopeFromRope[descriptor]]]
ENDLOOP;
stream.Put[rope[" ) "]];
DB.ReleaseRelshipSet[descRships]
END
ENDLOOP;
stream.Close[] };
WriteCatalogue:
PUBLIC
ENTRY
PROC [file: Rope.
ROPE] = {
ENABLE UNWIND => NULL;
stream ←
FS.StreamOpen[file, $append !
FS.Error => {
MessageWindow.Append[error.explanation];
stream ← NIL;
CONTINUE}];
IF stream # NIL THEN [] ← CarefullyApply[InternalWrite]
};
Opening, closing segment, making/reading catalogue
OpenUp: Booting.RollbackProc = {
DB.Initialize[nCachePages: 256] };
CloseTrans: ENTRY Booting.CheckpointProc = { CloseTransaction[] };
NewUserReset: ENTRY UserCredentials.CredentialsChangeProc = { CloseTransaction[] };
ProfileChangeReset:
ENTRY UserProfile.ProfileChangedProc = {
newToolDB: ROPE = UserProfile.Token[key: "Tool.Segment", default: "[Luther.Alpine]<CedarDoc>Tool.segment"];
IF
NOT Rope.Equal[ToolDB, newToolDB]
THEN {
don't open up the new database yet; simply remember that it must be done
ToolDB ← newToolDB;
pendingChange ← TRUE } };
ResetSchema:
INTERNAL
PROC[changingDBs:
BOOL] = {
IF pendingChange THEN CloseTransaction[];
IF toolTrans # NIL THEN RETURN;
IF NOT SetUpSegment[] THEN RETURN;
IF NOT DB.Null[toolDomain] THEN RETURN; -- all is well, don't bother recomputing schema
toolDomain ← DeclareDomain["Tool", $Tool];
FOR i: [0..6)
IN [0..6)
DO
propertyTable[i].prop ← DeclareProperty[relationName: propertyTable[i].name, of: toolDomain, is: RopeType, segment: $Tool]
ENDLOOP;
flavorRelation ← V2E[GetP[propertyTable[viewerFlavorProp].prop, aRelationIs, aRelationOf]];
flavorOf ← DB.DeclareAttribute[r: flavorRelation, name: "of", version: OldOnly];
descriptorRelation ← DeclareRelation[name: "Descriptor", segment: $Tool];
descriptorOf ← DeclareAttribute[r: descriptorRelation, name: "of", type: toolDomain];
descriptorIs ← DeclareAttribute[r: descriptorRelation, name: "is", type: RopeType];
toolTrans ← DB.TransactionOf[$Tool] };
ReadCatalogue:
PUBLIC
ENTRY
PROC[file: Rope.
ROPE] =
TRUSTED {
ENABLE
BEGIN
UNWIND => NULL;
LoadError => GOTO Failure;
END;
stream ← FS.StreamOpen[file ! FS.Error => {stream ← NIL; CONTINUE}];
IF stream = NIL THEN RETURN;
stream ← IOClasses.CreateCommentFilterStream[stream];
DB.MarkTransaction[toolTrans];
IF CarefullyApply[Parse] THEN DB.MarkTransaction[toolTrans]
ELSE DB.AbortTransaction[toolTrans]
EXITS
Failure => DB.AbortTransaction[toolTrans]; };
CarefullyApply:
INTERNAL
PROC [proc:
PROC[]]
RETURNS [succeeded:
BOOL] ~ {
ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded ← FALSE; GOTO Quit};
if there is a pending change of databases, then reset things before trying the operation
ResetSchema[changingDBs: pendingChange];
pendingChange ← FALSE;
activity ← TRUE;
succeeded ← TRUE;
proc[ ! DB.Aborted => { succeeded ← FALSE; CONTINUE } ];
IF succeeded THEN RETURN; -- no aborted occurred
DB.AbortTransaction[toolTrans];
toolTrans ← NIL; -- there isn't any transaction anymore
ResetSchema[changingDBs: FALSE];
proc[]; -- don't bother trying to restart here --
succeeded ← TRUE;
};
SetUpSegment:
INTERNAL
PROC[]
RETURNS [success:
BOOL] ~ {
ENABLE DB.Aborted, DB.Failure, DB.Error => {success ← FALSE; CONTINUE};
segment: ATOM = $Tool;
segmentNumber: NAT = 320B;
readOnly ← FALSE;
success ← TRUE;
DB.Initialize[nCachePages: 256];
DB.DeclareSegment[ToolDB, segment, segmentNumber, FALSE];
DB.OpenTransaction[segment !
DB.Error =>
IF code = ProtectionViolation THEN {success ← FALSE; CONTINUE} ELSE REJECT ];
IF
NOT success
THEN {
attempt to open for writing failed; open it for reading only
DB.CloseTransaction[DB.TransactionOf[segment]];
DB.DeclareSegment[ToolDB, segment, segmentNumber, TRUE, FALSE];
DB.OpenTransaction[segment];
success ← TRUE };
readOnly ← DB.GetSegmentInfo[segment].readOnly;
toolTrans ← DB.GetSegmentInfo[segment].trans;
NOTIFY transOpened -- start up the watch dog process again to try to shut it down
};
Initialization
TRUSTED {
Booting.RegisterProcs[c: CloseTrans, r: OpenUp];
UserProfile.CallWhenProfileChanges[ProfileChangeReset];
EstablishToolDB[];
Process.Detach[ FORK WatchDBActivity[] ] };
END.