-- 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,
    Inline 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, Inline, 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]];
        uniqueness _ LOOPHOLE[Inline.LowHalf[V2I[GetP[list.first, aUniquenessIs]]]];
        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
Ę•˜JšļĪcŧ
œĪk	œžœ
žœžœžœžœHžœœ
žœžœžœ
žœžœ
žœ(žœžœžœ
žœžœžœžœžœžœžœœžœžœ
žœ
žœĪnœžœ
ž	œžœ
œ
žœyžœ
žœžœ
žœ
žœœžœžœW#œ"žœžœ!žœ
žœOžœ?žœžœ!žœ
žœOžœ!œ*žœ'žœ
žœ
žœžœžœYžœ2œžœ#žœžœ
žœˇ
žœ4œ1žœžœžœ
žœ3&œžœ žœ	Ÿœžœ
ž	œžœžœ
žœžœ žœžœ
žœ=žœ*žœžœ
žœžœ=/œžœžœ
žœ!žœžœ
žœžœžœ
žœžœ
žœ	žœžœ
žœžœžœŸœž	œ#žœžœ
žœžœLžœžœœžœ9žœžœ
žœœ
žœ@žœžœ[žœžœœžœžœQžœ;Ÿœžœ
ž	œžœžœ#žœ
žœ
žœGžœžœžœžœ+-œxžœ!žœžœ
žœžœžœžœžœœ0žœ*žœžœ
žœžœ+žœ
žœ5žœžœ	œžœžœ
žœ
žœœ™
žœ
žœ
žœņžœ)žœ-œ#žœžœ
žœžœ-!œžœžœ
žœžœžœ
žœžœžœžœ
žœœžœ4žœ2žœ
žœžœ.žœ4žœžœžœžœ2œ;œ>œ@œUœ&œKžœ7žœ1žœKžœžœžœž
œ
žœžœ	žœ!žœŸ	œž	œžœžœežœžœžœ
žœBžœžœžœ3žœ:žœFžœ)žœžœ	žœĀ
žœ
Ÿœž	œžœžœ
žœžœžœ
žœ
žœ
žœžœ
žœ
žœžœ%žœžœ
žœžœ
žœ
žœ
žœ"žœžœžœ
žœŸœžœ
ž	œžœ
žœžœ-žœžœ
žœ
žœ%žœžœžœ
žœžœ.žœ
žœ
žœ
žœ!žœ
žœžœžœ[˜“F—…—#'ą