-- File: SquirrelDumpImpl.mesa
-- Contents: Program to do ascii database output.
-- Status: Runs in Cedar as subordinate of Squirrel.
-- Created by: Rick Cattell, March 1980; stolen from DBDump created September 1980
-- Last Edited by:
-- Cattell on: June 3, 1983 2:26 pm
-- Maxwell on: June 4, 1982 12:10 pm
-- Willie-Sue on: February 22, 1983 3:47 pm
-- Donahue on: April 5, 1983 10:13 am
-- Widom on: June 18, 1984 9:25:11 am PDT
-- Butler on: June 27, 1984 10:03:42 am PDT

-- Output formats:
-- SegmentName [other info] on the first line

-- /Domain|name|nametype| ...for each domain
-- /Relation|name| ...for each relation
-- /Attribute|name|relation|type|cardinality|length|link| ...for each attribute
-- /Index|relation|attribute|...|| .. for each index
-- /domain|name-elt1|name-elt2|...| ...for each entity
-- |relation|attr1:val1|attr2:val2|...| ...for each relship

-- In entity-centric mode, prints entities and relships that ref them in first attribute together.
-- Control characters are printed as "\nnn", in attribute values and entity names.

DIRECTORY
Atom USING [MakeAtom],
BasicTime,
Convert USING [RopeFromRope],
DBEnvironment USING [InternalError],
DB,
FS USING[StreamOpen],
IO,
SquirrelDump,
NutOps USING [EntityValued, FirstAttributeOf],
NutViewer USING [Message, MessageRope, squirrel, stopped],
Rope,
ViewerClasses;

SquirrelDumpImpl: CEDAR PROGRAM
IMPORTS
Atom, BasicTime, Convert, DBEnvironment, DB, FS, IO,
NutOps, NutViewer, Rope
EXPORTS
SquirrelDump -- DumpToFile -- =

BEGIN OPEN DB, IO;

inf: CARDINAL = 177777B;

IllegalEntity: SIGNAL = CODE;
IllegalFormat: SIGNAL = CODE;

squirrel: ViewerClasses.Viewer = NutViewer.squirrel;
start: BasicTime.GMT;
elapsedTime: INT;
entityCentricFlag: BOOL;


word: PROC [u: UNSPECIFIED] RETURNS [IO.Value] =
-- Temporary kluge for output of UNSPECIFIED to IO
INLINE {RETURN[[integer[LOOPHOLE[u, INTEGER]]]]};


-- Main procedure, exported to SquirrelDump

DumpToFile: PUBLIC PROC[segment: ROPE, fileName: ROPE, dl: LIST OF DB.Domain ← NIL,
rl: LIST OF DB.Relation ← NIL, complement: BOOL ← FALSE, entityCentric: BOOL ← FALSE] =
TRUSTED BEGIN
{ENABLE {
ABORTED => GO TO SqueakyClean;
DB.Failure => {NutViewer.Message[squirrel,
"Alpine problem, dump aborted; sorry! You may retry..."]; GO TO SqueakyClean};
DB.Aborted => {NutViewer.Message[squirrel,
"Alpine transaction aborted, yucko! You may retry..."]; GO TO SqueakyClean}};
file: IO.STREAM;
seg: Segment;
found: BOOLEAN ← FALSE;
start← BasicTime.Now[];
entityCentricFlag← entityCentric;
IF segment=NIL OR segment.Length[] = 0 THEN
{ NutViewer.Message[squirrel, "Must specify a segment to dump"]; RETURN};
IF fileName = NIL THEN fileName ← segment.Concat[".dump"];
file← OpenFile[fileName];
seg← Atom.MakeAtom[segment];
FOR sl: LIST OF Segment ← DB.GetSegments[], sl.rest UNTIL sl = NIL DO
IF sl.first = seg THEN { found ← TRUE; EXIT } ENDLOOP;
IF NOT found THEN { NutViewer.Message[squirrel, segment, " not open; aborting dump"]; RETURN };
NutViewer.Message[squirrel, "Dumping to ", fileName, ": "];
NutViewer.MessageRope[squirrel, "Data schema ..."];
IF complement THEN {
dl← Complement[dl, EntitySetToList[DomainSubset[d: DomainDomain, searchSegment: seg]]];
rl← Complement[rl, EntitySetToList[DomainSubset[d: RelationDomain, searchSegment: seg]]]};
file.Put[rope[segment], rope[" ["], time[]];
file.Put[rope["]\n"]];
WriteSchema[file, dl, rl];
NutViewer.MessageRope[squirrel, "Domains: "];
-- Output Domain contents
FOR list: LIST OF Domain ← dl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
NutViewer.MessageRope[squirrel, GetName[list.first]]; NutViewer.MessageRope[squirrel, "... "];
WriteDomain[file, list.first];
ENDLOOP;
IF entityCentric THEN {
NutViewer.MessageRope[squirrel, "Domain references: "];
FOR list: LIST OF Domain ← dl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
NutViewer.MessageRope[squirrel, GetName[list.first]]; NutViewer.MessageRope[squirrel, "... "];
WriteDomain[file, list.first, TRUE];
ENDLOOP;
NutViewer.MessageRope[squirrel, "Other "];
-- Output Relation contents
};
NutViewer.MessageRope[squirrel, "Relations: "];
-- Output Relation contents
FOR list: LIST OF Relation ← rl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
IF entityCentric AND FirstAttributeIsDomain[list.first] THEN LOOP;
NutViewer.MessageRope[squirrel, GetName[list.first]]; NutViewer.MessageRope[squirrel, "... "];
WriteRelation[file, list.first];
ENDLOOP;
CloseFile[file];
elapsedTime ← BasicTime.Period[ from: start, to: BasicTime.Now[] ];
NutViewer.Message[squirrel, PutFR["Dump completed: %g elapsed seconds.\n", int[elapsedTime]] ];
EXITS SqueakyClean => {}};
END;

FirstAttributeIsDomain: PROCEDURE[r: Relation]
RETURNS[BOOL] =
{RETURN[NutOps.EntityValued[NutOps.FirstAttributeOf[r]]]};

Complement: PROCEDURE[ignore: LIST OF Entity, all: LIST OF Entity]
RETURNS[complement: LIST OF Entity] =
BEGIN
found: BOOLEAN;
complementEnd: LIST OF Entity← NIL;
IF ignore = NIL THEN RETURN[all];
FOR listA: LIST OF Entity ← all, listA.rest WHILE listA # NIL DO
found ← FALSE;
FOR listI: LIST OF Entity ← ignore, listI.rest WHILE listI # NIL DO
IF Eq[listI.first, listA.first] THEN {found ← TRUE; EXIT};
ENDLOOP;
IF ~found THEN
-- Add to end of complement list (if NIL, create first element)
IF complement=NIL THEN
complement← complementEnd← LIST[listA.first]
ELSE
complementEnd← complementEnd.rest ← LIST[listA.first];
ENDLOOP;
END;

OpenFile: PUBLIC PROC[fileName: ROPE] RETURNS[file: IO.STREAM] =
TRUSTED BEGIN
IF fileName=NIL THEN {NutViewer.Message[squirrel, "Illegal file name for dump"]; RETURN};
file ← FS.StreamOpen[fileName: fileName, accessOptions: $create]
END;

CloseFile: PUBLIC PROC[fileStream: STREAM] = {fileStream.Close[]};

-- The output routines.

WriteSchema: PUBLIC PROC[s: IO.STREAM, dl: LIST OF DB.Domain, rl: LIST OF DB.Relation] =
BEGIN
subtype: Relship;
subtypeList: RelshipSet;
-- Output Domains
FOR list: LIST OF Domain ← dl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
WriteSystemEntity[s, list.first];
ENDLOOP;
-- Output SubTypes
FOR list: LIST OF Domain ← dl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
subtypeList ← RelationSubset[dSubType, LIST[[dSubTypeOf, list.first]]];
UNTIL Null[subtype← NextRelship[subtypeList]] AND NOT NutViewer.stopped DO
WriteSystemRelship[s, subtype]
ENDLOOP;
ReleaseRelshipSet[subtypeList];
ENDLOOP;
-- Output Relations
FOR list: LIST OF Relation ← rl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
WriteSystemEntity[s, list.first];
ENDLOOP;
-- Output Attributes
FOR list: LIST OF Relation ← rl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
FOR aL: LIST OF Attribute← VL2EL[GetPList[list.first, aRelationOf]],
     aL.rest UNTIL aL=NIL DO
WriteSystemEntity[s, aL.first]
ENDLOOP;
ENDLOOP;
-- Output Indexes
FOR list: LIST OF Relation ← rl, list.rest WHILE list # NIL AND NOT NutViewer.stopped DO
r: Relation← list.first;
FOR iL: LIST OF Index ← GetIndicesFor[r], iL.rest UNTIL iL = NIL OR NutViewer.stopped DO
WriteSystemEntity[s, iL.first, NameOf[r]]
ENDLOOP
ENDLOOP;
END;

WriteSystemEntity: PUBLIC PROC [s: IO.STREAM, e: Entity, also: ROPE← NIL] =
-- Will print a domain, relation, attribute, or index and any
-- associated properties that are needed to recreate it.
BEGIN type: Domain← DomainOf[e];
IF NutViewer.stopped THEN RETURN;
SELECT type FROM
DomainDomain =>
s.Put[rope["/Domain|"], rope[GetName[e]], char['|]];
RelationDomain => s.Put[
rope["/Relation|"], rope[GetName[e]], char['|] ];
AttributeDomain => {
s.Put[rope["/Attribute|"], rope[GetName[V2E[GetP[e, aRelationIs]]]], char['|]];
s.Put[rope[GetName[e]], char['|]];
s.Put[rope[GetName[V2E[GetP[e, aTypeIs]]]], char['|]];
s.Put[word[V2U[GetP[e, DB.aUniquenessIs]]], char['|]];
s.Put[int[V2I[GetP[e, DB.aLengthIs]]], char['|]];
s.Put[word[V2U[GetP[e, DB.aLinkIs]]], char['|]] };
IndexDomain => {
-- First get all of the index factors for this index,
-- then the attribute associated with each index factor and print it
s.Put[rope["/Index|"], rope[also], rope["|"]];
FOR ifList: LIST OF DB.Value ← GetPList[e, ifIndexOf, ifIndexIs], ifList.rest
UNTIL ifList = NIL OR NutViewer.stopped DO
s.Put[ rope[NameOf[V2E[GetP[V2E[ifList.first], ifAttributeIs]]]], rope["|"] ]
ENDLOOP;
s.Put[ rope["|"] ] };
ENDCASE;
s.Put[char[CR]];
END;

WriteSystemRelship: PUBLIC PROC [s: IO.STREAM, r: Relship] =
-- Prints a subtype relship.
BEGIN
IF NutViewer.stopped THEN RETURN;
s.Put[rope["|SubType|"]];
s.Put[rope["of:"], rope[GetFS[r, dSubTypeOf]], char['|]];
s.Put[rope["is:"], rope[GetFS[r, dSubTypeIs]], char['|]];
s.Put[char[CR]];
END;

WriteDomain: PUBLIC PROC[s: IO.STREAM, d: Domain, refs: BOOL← FALSE] =
-- Prints entities unless refs=TRUE, in which case prints relships reffing.
BEGIN
entity: Entity;
entityList: EntitySet← DomainSubset[d: d, searchSubDomains: FALSE];
UNTIL Null[entity← NextEntity[entityList]] OR NutViewer.stopped DO
IF refs THEN WriteRelatedRelships[s, entity] ELSE WriteEntity[s, entity] ENDLOOP;
ReleaseEntitySet[entityList];
END;

WriteEntity: PUBLIC PROC[s: IO.STREAM, e: Entity] =
-- Prints an entity in ascii dump form: /domain\name\
TRUSTED BEGIN ENABLE DBEnvironment.InternalError => GOTO Error;
d: Domain← DomainOf[e];
IF NutViewer.stopped THEN RETURN;
s.Put[char['/], rope[GetName[d]], char['|]];
s.Put[rope[RopeFromRope[GetName[e]]], char['|], char[CR]];
EXITS Error =>
{NutViewer.Message[squirrel, "Ouch! Internal error on entity."]};
END;

WriteRelatedRelships: PUBLIC PROC[fh: IO.STREAM, e: Entity] =
-- Prints relships that reference e in their first attribute.
BEGIN
t: Relship;
r: Relation;
rs: RelshipSet;
al: AttributeList;
al← GetAllRefAttributes[e];
FOR alT: AttributeList← al, alT.rest UNTIL alT=NIL DO
r← V2E[GetP[alT.first, aRelationIs]];
IF Eq[alT.first, NutOps.FirstAttributeOf[r]] THEN
BEGIN
rs← RelationSubset[r, LIST[[alT.first, e]]];
UNTIL Null[t← NextRelship[rs]] DO
WriteRelship[fh, t] ENDLOOP;
ReleaseRelshipSet[rs];
END;
ENDLOOP;
END;

WriteRelation: PUBLIC PROC[s: IO.STREAM, r: Relation] =
BEGIN
relship: Relship;
relshipList: RelshipSet← RelationSubset[r];
UNTIL Null[relship← NextRelship[relshipList]] OR NutViewer.stopped DO
WriteRelship[s, relship] ENDLOOP;
ReleaseRelshipSet[relshipList];
END;

WriteRelship: PUBLIC PROC[s: IO.STREAM, r: Relship] =
-- Prints a relship in ascii dump form: \relation\a1:v1\...\aN:vN\
TRUSTED BEGIN ENABLE DBEnvironment.InternalError => GOTO Error;
ts: Relation← RelationOf[r];
IF NutViewer.stopped THEN RETURN;
s.Put[char['|], rope[GetName[ts]], char['|]];
FOR aL: LIST OF Attribute← VL2EL[GetPList[ts, aRelationOf]], aL.rest UNTIL aL=NIL DO
s.Put[rope[GetName[aL.first]], char[':]];
s.Put[rope[RopeFromRope[GetFS[r, aL.first]]], char['|]];
ENDLOOP;
s.Put[char[CR]];
EXITS Error =>
{NutViewer.Message[squirrel, "Ouch! Internal error on relship"]};
END;

GetIndicesFor: PROC [r: Relation] RETURNS [LIST OF Index] =
-- Returns the list of indices on r. Must first find attributes of r, then find any index
-- factors involving those attributes, then find the indices to which the index factors belong,
-- removing duplicates (indices with more than one index factor will appear more than once).
BEGIN il: LIST OF Index ← NIL;
FOR al: LIST OF Attribute ← VL2EL[GetPList[r, aRelationOf]], al.rest UNTIL al=NIL DO
if: IndexFactor ← V2E[GetP[al.first, ifAttributeOf]];
IF if#NIL THEN il ← AppendIfNew[V2E[GetP[if, ifIndexIs]], il];
ENDLOOP;
RETURN[il]
END;

AppendIfNew: PROC[e: Entity, el: LIST OF Entity] RETURNS [LIST OF Entity] =
-- Add entity e to list el if it is not already in the list.
BEGIN elT: LIST OF Entity;
FOR elT← el, elT.rest UNTIL elT=NIL DO IF Eq[elT.first, e] THEN RETURN[el] ENDLOOP;
RETURN[CONS[e, el]];
END;

RopeFromRope: PROC[from: ROPE] RETURNS [to: ROPE] =
-- Inserts funny backslashes where special characters appear
BEGIN new: ROPE;
IF from.Length[]=0 THEN RETURN[from];
new← Convert.RopeFromRope[from];
RETURN[new.Substr[1, new.Length[]-2]]; -- to get rid of quotes!
END;

EraseDomains: PUBLIC PROC [dl: LIST OF DB.Domain] = {
-- Erases all domains in dl, all their entities, and all relations that ref them. Careful. . .
al: LIST OF DB.Attribute;
FOR dlT: LIST OF DB.Domain ← dl, dlT.rest WHILE NOT (dlT = NIL) DO
-- First destroy the relations that ref dlT.first (CedarDB would, but we want to tell user)
IF (al ← DB.VL2EL[DB.GetPList[dlT.first, DB.aTypeOf]]) # NIL THEN
{NutViewer.Message[squirrel, "Erasing Relations referencing ", DB.GetName[dlT.first], ":"];
EraseAttributesRelations[al]};
NutViewer.Message[squirrel, "Erasing Domain ", DB.GetName[dlT.first], ". . ."];
DB.DestroyDomain[dlT.first]
ENDLOOP;
};

EraseRelations: PUBLIC PROC [rl: LIST OF DB.Relation] = {
-- Erases all relations in rl, and all their relships. Careful. . .
FOR rlT: LIST OF DB.Relation ← rl, rlT.rest WHILE NOT (rlT = NIL) DO
NutViewer.Message[squirrel, "Erasing Relation ", DB.GetName[rlT.first], ". . ."];
DB.DestroyRelation[rlT.first]
ENDLOOP;
};

EraseAttributesRelations: PROC [al: LIST OF DB.Attribute] = {
-- Erases relations that attributes belong to
OPEN DB;
FOR alT: LIST OF Attribute ← al, alT.rest WHILE NOT (alT = NIL) DO
IF NOT DB.Null[alT.first] THEN
{r: DB.Relation ← V2E[GetP[alT.first, aRelationIs]];
NutViewer.Message[squirrel, "Erasing Relation ", DB.GetName[r], ". . ."];
DB.DestroyRelation[r]}
ENDLOOP;
};




END.

Change log since October 1982:

By Cattell October 11, 1982 10:54 pm: Changed Complement procedure so that it keeps the list in the same order as the input, but using a complementEnd variable. Added timing of dump.

Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system properties.

Willie-Sue January 11, 1983 3:32 pm: new output format for segments

Cattell April 6, 1983 10:35 am: fix comments at top.

Cattell November 18, 1983 4:27 pm: convert to new format allowing "\"s in relship fields.