-- SchemaCopyImpl.mesa
-- last edited by
-- Maxwell, June 8, 1982 9:30 am
-- Willie-Sue on: February 22, 1983 3:58 pm
-- Donahue, June 1, 1983 4:25 pm
-- Cattell, May 30, 1983 7:08 pm

DIRECTORY
DB,
PrincOpsUtils USING [LowHalf],
IO,
MessageWindow USING[ Append ],
NutOps USING[ AttributesOf, EntityValued, GetRefAttributes, GetRelation ],
Rope USING [Cat, Equal, --Length, -- ROPE],
Schema USING [];

SchemaCopyImpl: CEDAR PROGRAM
IMPORTS DB, PrincOpsUtils, MessageWindow, NutOps, Rope
EXPORTS Schema =
BEGIN
OPEN DB, IO;

ROPE: TYPE = Rope.ROPE;

debugging: BOOLEAN ← FALSE;

-- copying Domains --

PairList: TYPE = LIST OF RECORD[oldR, newR: Relation];

CopyDomainContents: PUBLIC PROCEDURE[oldD, newD: Domain] =
BEGIN -- non-destructive copy
name: ROPE;
es: EntitySet;
entity: Entity;
pairs: PairList;
rs: RelshipSet;
subTypeRS: Relship;
relations: LIST OF Relation;
IF oldD = newD THEN ERROR; -- what could he be doing?
IF debugging THEN
MessageWindow.Append[Rope.Cat["Copying the contents of ", NameOf[oldD]]];
-- 1) copy the sub and super types
rs ← RelationSubset[dSubType, LIST[[dSubTypeOf, oldD]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
DeclareSubType[of: V2E[GetF[subTypeRS, dSubTypeIs]], is: newD];
ENDLOOP;
ReleaseRelshipSet[rs];
rs ← RelationSubset[dSubType, LIST[[dSubTypeIs, oldD]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
DeclareSubType[of: newD, is: V2E[GetF[subTypeRS, dSubTypeOf]]];
ENDLOOP;
ReleaseRelshipSet[rs];
-- 2) build the new schema
relations ← GetRelationsOf[oldD];
FOR relations ← relations, relations.rest WHILE relations # NIL DO
pairs ← CONS[[relations.first, NIL], pairs];
pairs.first.newR ← UpdateRelation[relations.first, oldD, newD];
ENDLOOP;
-- 3) copy the relships (may create new entities)
FOR list: PairList ← pairs, list.rest WHILE list # NIL DO
name ← GetName[list.first.oldR];
CopyRelships[list.first.oldR, list.first.newR];
DestroyRelation[list.first.oldR];
SetName[list.first.newR, name];
ENDLOOP;
-- 4) copy the entities that were missed by step 2.
es ← DomainSubset[d: oldD, searchSubDomains: FALSE];
WHILE (entity ← NextEntity[es]) # NIL DO
[] ← DeclareEntity[newD, GetName[entity]]; -- will create it if it doesn't exist
ENDLOOP;
ReleaseEntitySet[es];
END;

GetRelationsOf: PUBLIC PROCEDURE[d: Domain] RETURNS[relations: LIST OF Relation] =
BEGIN
newR: Relation;
found: BOOLEAN;
attributes: LIST OF Attribute;
attributes ← NutOps.GetRefAttributes[d];
FOR attributes ← attributes, attributes.rest WHILE attributes # NIL DO
found ← FALSE;
newR ← NutOps.GetRelation[attributes.first];
-- find out if relation is already in the list
FOR list: LIST OF Relation ← relations, list.rest WHILE list # NIL DO
IF Eq[list.first, newR] THEN {found ← TRUE; EXIT};
ENDLOOP;
IF ~found THEN relations ← CONS[newR, relations];
ENDLOOP;
END;

UpdateRelation: PROCEDURE[r: Relation, oldD, newD: Domain] RETURNS[new: Relation] =
BEGIN
length: INT;
name: ROPE;
type: DataType;
uniqueness: Uniqueness;
new ← DeclareRelation[NIL, NIL]; -- unique anonomous relation
FOR list: AttributeList ← NutOps.AttributesOf[r], list.rest WHILE list # NIL DO
name ← GetName[list.first];
type ← V2E[GetP[list.first, aTypeIs]];
length ← V2I[GetP[list.first, aLengthIs]];
TRUSTED
{ ref: REF POINTER = LOOPHOLE[GetP[list.first, aUniquenessIs]];
uniqueness ← LOOPHOLE[PrincOpsUtils.LowHalf[ref^]]};
IF Eq[type, oldD] THEN type ← newD;
[] ← DeclareAttribute[new, name, type, uniqueness, length];
ENDLOOP;
END;

-- copying Relations --

Pair: TYPE = RECORD[oldA, newA: Attribute, oldDT, newDT: Entity, change: TypeChange];
TypeChange: TYPE = {none, new, superType, subType, newData, oldData};

CopyRelships: PUBLIC PROCEDURE[oldR, newR: Relation] =
BEGIN
error: ROPE;
rs: RelshipSet;
newName: ROPE;
pairs: LIST OF Pair;
oldDT, newDT: Entity;
oldRS, newRS: Relship;
first: BOOLEAN ← TRUE;
open: BOOLEAN ← FALSE;
oldList, newList: AttributeList;
-- construct list of new/old attribute pairs
oldList ← NutOps.AttributesOf[oldR];
newList ← NutOps.AttributesOf[newR];
newList ← SortByKey[newList];
FOR newList ← newList, newList.rest WHILE newList # NIL DO
pairs ← CONS[[NIL, newList.first, NIL, NIL, new], pairs];
-- find matching old attribute
newName ← GetName[newList.first];
FOR list: AttributeList ← oldList, list.rest WHILE list # NIL DO
IF ~Rope.Equal[GetName[list.first], newName] THEN LOOP;
pairs.first.oldA ← list.first;
EXIT; ENDLOOP;
-- determine type change
IF pairs.first.oldA = NIL THEN LOOP; -- a new attribute
oldDT ← pairs.first.oldDT ← V2E[GetP[pairs.first.oldA, aTypeIs]];
newDT ← pairs.first.newDT ← V2E[GetP[pairs.first.newA, aTypeIs]];
SELECT TRUE FROM
Eq[oldDT, newDT] => pairs.first.change ← none;
~NutOps.EntityValued[pairs.first.newA] => pairs.first.change ← newData;
~NutOps.EntityValued[pairs.first.oldA] => pairs.first.change ← oldData;
newDT = AnyDomainType => pairs.first.change ← subType;
oldDT = AnyDomainType => pairs.first.change ← superType;
SubType[oldDT, newDT] => pairs.first.change ← subType;
SubType[newDT, oldDT] => pairs.first.change ← superType;
ENDCASE => pairs.first.change ← oldData;
ENDLOOP;
-- create new relationships one at a time
rs ← RelationSubset[oldR];
WHILE (oldRS ← NextRelship[rs]) # NIL DO
first ← TRUE;
newRS ← CreateRelship[newR];
-- copy attributes one at a time
FOR list: LIST OF Pair ← pairs, list.rest WHILE list # NIL DO
BEGIN
OPEN list.first;
ENABLE DB.Error => -- catch errors
{ IF code=MismatchedAttributeValueType
THEN error ← " is an illegal value."
ELSE IF code=NonUniqueKeyValue THEN error ← " already exists."
ELSE error ← " has an unknown problem.";
GOTO ErrorExit};
SELECT change FROM
new => NULL; -- no corresponding attribute in the old relation
none => SetF[newRS, newA, GetF[oldRS, oldA]]; -- copy field value
subType => SetF[newRS, newA, GetF[oldRS, oldA]]; -- ditto (always legal)
newData => SetFS[newRS, newA, GetFS[oldRS, oldA]]; -- coerce to data (dangerous)
oldData => SetF[newRS, newA, DeclareEntity[newDT, GetFS[oldRS, oldA]]]; -- coerce
superType => { -- the particular entity MAY be valid
oldValue: Entity ← V2E[GetF[oldRS, oldA]];
IF SubType[DomainOf[oldValue], newDT]
THEN SetF[newRS, newA, oldValue]
ELSE SetF[newRS, newA, DeclareEntity[newDT, GetName[oldValue]]]};
ENDCASE => ERROR;
EXITS ErrorExit => { };
END;
ENDLOOP;
ENDLOOP;
ReleaseRelshipSet[rs];
END;

SortByKey: PROCEDURE[list: AttributeList] RETURNS[newList: AttributeList] =
BEGIN
uniqueness: Uniqueness;
noneList, keyList, keyPartList, optionalKeyList: AttributeList;
FOR list ← list, list.rest WHILE list # NIL DO
uniqueness ← V2U[GetP[list.first, aUniquenessIs]];
SELECT uniqueness FROM
None => noneList ← CONS[list.first, noneList];
Key => keyList ← CONS[list.first, keyList];
KeyPart => keyPartList ← CONS[list.first, keyPartList];
OptionalKey => optionalKeyList ← CONS[list.first, optionalKeyList];
ENDCASE => ERROR;
ENDLOOP;
newList ← keyList;
newList ← Append[list: newList, to: keyPartList];
newList ← Append[list: newList, to: optionalKeyList];
newList ← Append[list: newList, to: noneList];
END;

Append: PROCEDURE[list, to: AttributeList] RETURNS[AttributeList] =
INLINE BEGIN
IF list = NIL THEN RETURN[to];
IF to = NIL THEN RETURN[list];
FOR temp: AttributeList ← to, temp.rest WHILE temp # NIL DO
IF temp.rest # NIL THEN LOOP;
temp.rest ← list;
EXIT; ENDLOOP;
RETURN[to];
END;

SubType: PUBLIC PROCEDURE[sub, super: Domain] RETURNS[BOOLEAN] =
BEGIN
rs: RelshipSet;
subRS: Relship;
IF Eq[sub, super] THEN RETURN[TRUE];
rs ← RelationSubset[dSubType, LIST[[dSubTypeIs, sub]]];
WHILE (subRS ← NextRelship[rs]) # NIL DO
IF SubType[V2E[GetF[subRS, dSubTypeOf]], super] THEN RETURN[TRUE];
ENDLOOP;
ReleaseRelshipSet[rs];
RETURN[FALSE];
END;

END.

Change log.

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