-- file DBLoadImpl.mesa
-- created by Donahue, December 28, 1982 10:14 am
-- last edited by Donahue, December 30, 1982 8:37 am

DIRECTORY IO, Rope, DBView, DBLoad;

DBLoadImpl: PROGRAM  IMPORTS IO, Rope, DBView EXPORTS DBLoad = 
{ OPEN IO, Rope, DBView;
   BadInput: ERROR = CODE;
   ControlZ: CHARACTER = 032C;

  CreateEntity: PUBLIC PROC[ s: IO.STREAM ] RETURNS[ ok: BOOLEAN ] = {
     ENABLE BadInput => GOTO Quit;
     ok _ TRUE;
      SELECT s.GetChar[] FROM
      '/ => {dName, eName: ROPE;
             d: Domain;
             dName _ ReadString[s, FALSE];
             d _ DeclareDomain[name: dName, version: Version[OldOnly]
                                         ! NotFound => { SkipThruCR[s]; GOTO Quit } ];
             eName _ ReadString[s];
             [] _ DBView.CreateEntity[d: d, name: eName ! NonUniqueEntityName =>
                                                     { SkipThruCR[s]; GOTO Quit }] };
      ENDCASE => ok _ FALSE;
     SkipThruCR[ s ];
     EXITS
       Quit => RETURN[FALSE]; };
  
  DestroyEntity: PUBLIC PROC[ s: IO.STREAM ] RETURNS[ ok: BOOLEAN ] = {
    ENABLE BadInput => GOTO Quit;
    ok _ TRUE;
      SELECT s.GetChar[] FROM
      '/ => {dName, eName: ROPE;
             d: Domain;
             entity: Entity;
             dName _ ReadString[s, FALSE];
             d _ DeclareDomain[name: dName, version: Version[OldOnly]
                                         ! NotFound => { SkipThruCR[s]; GOTO Quit } ];
             eName _ ReadString[s];
             entity _ GetEntityByName[d, eName ! NotFound =>
                                                             { SkipThruCR[s]; GOTO Quit }];
             DBView.DestroyEntity[ entity ] };
      ENDCASE => ok _ FALSE;
     SkipThruCR[ s ];
     EXITS
       Quit => RETURN[FALSE]; };
  
  CreateRelship: PUBLIC PROC[ s: IO.STREAM ] RETURNS[ ok: BOOLEAN ] = {
    ENABLE BadInput => GOTO Quit;
    ok _ TRUE;
    SELECT s.GetChar[] FROM
      '\\ =>
         { rName: ROPE;
          r: Relation;
          AttrList: AttributeValueList;
          rName _ ReadString[s, FALSE];
          r _ DeclareRelation[ name: rName, version: Version[OldOnly]
                                  ! NotFound => { SkipThruCR[s]; GOTO Quit } ];
          AttrList _ CollectAttr[ r, s ];
          IF CheckExistingRelship[ r, AttrList ] = NIL THEN
            [] _ DBView.CreateRelship[ r, AttrList ]; };
      ENDCASE => { SkipThruCR[s]; ok _ FALSE };
    EXITS 
      Quit => RETURN[FALSE]; };
  
  DestroyRelship: PUBLIC PROC[ s: IO.STREAM ] RETURNS[ ok: BOOLEAN ] = {
    ENABLE BadInput => GOTO Quit;
    ok _ TRUE;
    SELECT s.GetChar[] FROM
      '\\ =>
         { rName: ROPE;
          r: Relation;
          AttrList: AttributeValueList;
          relship: Relship;
          rName _ ReadString[s, FALSE];
          r _ DeclareRelation[ name: rName, version: Version[OldOnly]
                                  ! NotFound => { SkipThruCR[s]; GOTO Quit } ];
          AttrList _ CollectAttr[ r, s ];
          relship _ CheckExistingRelship[ r, AttrList ];
          IF relship # NIL THEN DBView.DestroyRelship[ relship ]; };
      ENDCASE => { SkipThruCR[s]; ok _ FALSE };
    EXITS 
      Quit => RETURN[FALSE];};
  
  CollectAttr: PROC[ r: Relation, s: IO.STREAM ] RETURNS[ attr: AttributeValueList ] = {
   fieldName: ROPE;
   field: Attribute;
   valString: ROPE;
   type: Entity;
   val: Value;
   attr _ NIL;
   UNTIL (fieldName _ ReadName[s]) = NIL DO
    field _ DeclareAttribute[r: r, name: fieldName, version: OldOnly
                                  ! NotFound => ERROR BadInput ];
    type _ V2E[GetP[field, aTypeProp]];
    valString _ ReadString[s, FALSE];
    SELECT type FROM
      IntType => { val _ I2V[ IO.GetInt[ IO.RIS[valString] ] ] };
      StringType => { val _ S2V[ valString ] };
      BoolType => { val _ B2V[ Rope.Equal[valString, "TRUE"] ] };
      ENDCASE => { val _ DeclareEntity[ d: type, name: valString ] };
    attr _ CONS[ AttributeValue[ field, val ], attr ]
   ENDLOOP };
  
  CheckExistingRelship: PROC[r: Relation, attr: AttributeValueList] RETURNS[relship: Relship] =
  { rs: RelshipSet = RelationSubset[ r, attr ];
    relship _ IF rs # NIL THEN NextRelship[rs] ELSE NIL;
    ReleaseRelshipSet[rs] };
    
  ReadName: PROC[s: IO.STREAM] RETURNS[ROPE] =
  -- Terminates on reading a ":" or a CR; returns NIL in latter case.
  BEGIN
  lastBreak: CHAR;
  r: ROPE_ s.GetRope[NameBreak, NoBreak];
  NoBreak: BreakProc = CHECKED {RETURN[KeepGoing]};
  NameBreak: BreakProc =  CHECKED {
    lastBreak _ c;
    IF c = ControlZ THEN {SkipThruCR[s]; RETURN[StopAndTossChar]}
    ELSE IF c = '\\ OR c = CR OR c = ': THEN RETURN[StopAndTossChar]
    ELSE RETURN[KeepGoing] };
  IF r = NIL THEN r _ ""; -- kluge
  IF r.Length[]=0 THEN
    IF lastBreak=': THEN ERROR BadInput ELSE RETURN[NIL]
  ELSE RETURN[r]
  END;
  
  SkipThruCR: SAFE PROC[ s: IO.STREAM ] = CHECKED
  { c: CHARACTER; WHILE (c _ s.GetChar[]) # CR DO ENDLOOP };
  
  ReadString: PROC[s: IO.STREAM, nonNull: BOOLEAN _ TRUE] RETURNS[ROPE] =
  -- Terminates on reading a "\"; may return a null string if find immediately.
  -- Null string generates error if nonNull=TRUE.
  BEGIN
  r: ROPE_ s.GetRope[NameBreak, NoBreak];
  NoBreak: BreakProc = CHECKED {RETURN[KeepGoing]};
  NameBreak: BreakProc =  CHECKED {
    IF c='\\ THEN RETURN[StopAndTossChar]
    ELSE RETURN[KeepGoing] };
  IF r=NIL THEN r_ ""; -- kluge, i don't know why GetRope returns NIL
  IF r.Length[]=0 AND nonNull THEN { SkipThruCR[s]; ERROR BadInput } ELSE RETURN[r]
  END; }.