
<<File: DBToolsImpl.mesa>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Last Edited by: Donahue, January 27, 1986 8:01:15 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>>
<<>>
DIRECTORY
Atom USING [MakeAtom, GetPName, DottedPair, DottedPairNode],
Commander,
CommandTool,
DBTools,
FS,
Booting USING [CheckpointProc, RegisterProcs, RollbackProc],
Convert USING[RopeFromRope],
DB,
IO,
IOClasses,
TextFind,
Process USING[Ticks, SecondsToTicks, Detach, Pause],
Rope USING [Cat, Equal, Substr, ROPE, Concat],
UserCredentials USING[CredentialsChangeProc, Get],
ViewerClasses
;


DBToolsImpl: CEDAR MONITOR

IMPORTS Atom, Booting, Commander, CommandTool, Convert, FS, IO, IOClasses, Process, Rope, DB, TextFind, UserCredentials

EXPORTS DBTools 

= BEGIN 
OPEN DB, 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;

stopped: BOOL _ TRUE;

stupidProperty: Atom.DottedPair = NEW[Atom.DottedPairNode _ [key: $DBToolCommandHandle, val: NIL]];

crockCmdHandle: Commander.Handle = NEW[Commander.CommandObject _ [propertyList: LIST[stupidProperty]]];

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;
defaultUserSearchRule: ROPE = Rope.Cat["///Users/", UserCredentials.Get[].name, "/Commands/"];
defaultSearchRules: LIST OF ROPE = LIST[defaultUserSearchRule, "///Commands/"];
<<Set the search rules for the command handle from the list given>>
CommandTool.AddSearchRule[crockCmdHandle, NIL];  -- throw previous ones away
FOR rules: LIST OF ROPE _ defaultSearchRules, rules.rest UNTIL rules = NIL DO
CommandTool.AddSearchRule[crockCmdHandle, rules.first]
ENDLOOP;
IF Rope.Equal[ToolDB, file] THEN RETURN;
ToolDB _ file;
stopped _ TRUE; -- protection against errors that might arise in the opening
CloseTransaction[];
OpenDB[];
stopped _ FALSE };

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 [] = {
ENABLE UNWIND => NULL;
CloseTransaction[];
stopped _ TRUE };

CloseTransaction: INTERNAL PROC [] = {
caughtAborted: BOOL _ FALSE;
IF toolTrans = NIL THEN toolTrans _ DB.GetSegmentInfo[$Tool].trans;
IF toolTrans = NIL THEN RETURN;
DB.CloseTransaction[toolTrans !
DB.Aborted => { caughtAborted _ TRUE; CONTINUE };
DB.Error, DB.Failure => CONTINUE ];
IF caughtAborted THEN DB.AbortTransaction[toolTrans];
toolTrans _ NIL }; 

OpenTransaction: INTERNAL PROC [] = {
IF toolTrans = NIL THEN DB.OpenTransaction[$Tool];
toolTrans _ DB.GetSegmentInfo[$Tool].trans };
<<Accessing Tools>>
RegisterTool: PUBLIC ENTRY PROC [toolName, loadFile: ROPE] ~ {
ENABLE UNWIND => NULL;
IF InternalRegisterTool[toolName: toolName, loadFile: loadFile] THEN DB.MarkTransaction[toolTrans] };

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 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] ~ {
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[descriptors.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] = {
ENABLE UNWIND => NULL;
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
toolSet: DB.EntitySet = DB.DomainSubset[toolDomain];
FOR nextTool: DB.Entity _ DB.NextEntity[toolSet], DB.NextEntity[toolSet] UNTIL nextTool = NIL DO
tools _ CONS[DB.NameOf[nextTool], tools]
ENDLOOP;
DB.ReleaseEntitySet[toolSet];
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] ~ {
loadFile: ROPE = InternalGetToolProps[toolName].loadFile;
IF Rope.Equal[loadFile, ""] OR CheckLoaded[loadFile] THEN RETURN;
DoCommand[Rope.Cat["Source ", loadFile, "\n"], errorStream];
loadedList _ CONS[loadFile, loadedList]
};

LoadTool: PUBLIC ENTRY PROC [toolName: ROPE, errorStream: IO.STREAM _ IO.noWhereStream] ~ { ENABLE UNWIND => NULL; 
InternalLoadTool[toolName, errorStream] };

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] ~ {
ENABLE UNWIND => NULL;
DoApplyTool: INTERNAL PROC[] ~ {
command: ROPE;
IF DB.DeclareEntity[toolDomain, toolName, OldOnly] = NIL THEN RETURN;
InternalLoadTool[toolName, errorStream];
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] ] } };
[] _ CarefullyApply[DoApplyTool]
};

DoCommand: PROC[commandLine: ROPE, errorStream: IO.STREAM _ IO.noWhereStream] = {
crockCmdHandle.err _ errorStream;
crockCmdHandle.out _ IO.noWhereStream;
[] _ CommandTool.DoCommandRope[commandLine: commandLine, parent: crockCmdHandle] };

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, OldOnly];
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[pattern: namePattern, addBounds: TRUE];
IF TextFind.SearchRope[pattern, viewerName].found 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: INT;
[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 = stream.GetRopeLiteral[ ! IO.EndOfStream => GOTO Done];
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;
DB.MarkTransaction[toolTrans]
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[Convert.RopeFromRope[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];
DB.MarkTransaction[toolTrans]
END
ENDLOOP;
stream.Close[] };

WriteCatalogue: PUBLIC ENTRY PROC [file: Rope.ROPE] = {
ENABLE UNWIND => NULL;
stream _ FS.StreamOpen[file, $append ! FS.Error => {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 = {
ENABLE UNWIND => NULL;
CloseTransaction[] };

NewUserReset: ENTRY UserCredentials.CredentialsChangeProc = {
ENABLE UNWIND => NULL;
CloseTransaction[];
stopped _ TRUE };

ResetSchema: INTERNAL PROC[] = {
OpenTransaction[];
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] };

ReadCatalogue: PUBLIC ENTRY PROC[file: Rope.ROPE, eraseFirst: BOOL _ FALSE] = TRUSTED {
ENABLE BEGIN
UNWIND => NULL;
LoadError => GOTO Failure;
END;
DoRead: INTERNAL PROC[] = TRUSTED { 
IF eraseFirst THEN {
DB.EraseSegment[$Tool];
ResetSchema[] };
Parse[];
DB.MarkTransaction[toolTrans] };
stream _ FS.StreamOpen[file ! FS.Error => {stream _ NIL; CONTINUE}];
IF stream = NIL THEN RETURN;
stream _ IOClasses.CreateCommentFilterStream[stream];
IF NOT CarefullyApply[DoRead] THEN {
DB.AbortTransaction[toolTrans ! DB.Error => CONTINUE];
toolTrans _ NIL }
EXITS
Failure => {
DB.AbortTransaction[toolTrans ! DB.Error => CONTINUE];
toolTrans _ NIL} };

CarefullyApply: INTERNAL PROC [proc: PROC[]] RETURNS [succeeded: BOOL] ~ {
ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded _ FALSE; CONTINUE};
aborted: BOOL _ FALSE;
succeeded _ TRUE;
IF stopped THEN RETURN;
BEGIN
ENABLE DB.Aborted => { aborted _ TRUE; CONTINUE };
ResetSchema[];
proc[]
END;
IF NOT aborted THEN RETURN; -- no aborted occurred
DB.AbortTransaction[toolTrans];
ResetSchema[];
proc[]; -- don't bother trying to restart here --
};

OpenDB: INTERNAL PROC[] ~ {
ENABLE DB.Aborted, DB.Failure, DB.Error => CONTINUE;
segmentNumber: NAT = 320B;
readOnly _ FALSE;
DB.Initialize[nCachePages: 256];
DB.DeclareSegment[ToolDB, $Tool, segmentNumber, FALSE];
<<this is a crock to see if the database really can be written to; you need to actually open a transaction to find this out>>
OpenTransaction[! DB.Error =>
IF code = ProtectionViolation THEN {readOnly _ TRUE; CONTINUE} ELSE GOTO AlreadyDone ];
IF readOnly THEN {
<<attempt to open for writing failed; open it for reading only>>
CloseTransaction[];
DB.DeclareSegment[ToolDB, $Tool, segmentNumber, TRUE, FALSE] }
ELSE CloseTransaction[];  -- throw away this worthless transaction
NOTIFY transOpened -- start up the watch dog process again to try to shut it down
EXITS
AlreadyDone => CloseTransaction[! DB.Error, DB.Failure => CONTINUE]
};

OpenIt: Commander.CommandProc = {
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
[] _ h.SkipWhitespace[];
IF h.EndOf THEN name _ NIL ELSE name _ h.GetLineRope[];
IF Rope.Equal[name, ""] THEN 
IF ToolDB # NIL THEN name _ ToolDB
ELSE msg _ "Must supply a database name";
EstablishToolDB[name]
};

CloseIt: Commander.CommandProc = { Close[] };
<<Initialization>>
TRUSTED {
Booting.RegisterProcs[c: CloseTrans, r: OpenUp];
Commander.Register[key: "OpenToolDB", proc: OpenIt, doc: "\nOpenToolDB <file> opens a new tool database (closing a previously open 
one, if necessary)"];
Commander.Register[key: "CloseToolDB", proc: CloseIt, doc: "\nCloseToolDB <file> closes the tool database"];
Process.Detach[ FORK WatchDBActivity[] ] };


END.