-- File: VLTest1Impl.mesa -- Contents: Simple test program for DBView.mesa -- Created by: Rick Cattell, 12-Aug-81 -- Derived from: TLTest1Impl -- Last Edited by: Cattell, March 25, 1983 3:47 pm DIRECTORY DB, IO, Rope, ViewerIO; VLTest1Impl: PROGRAM IMPORTS DB, IO, Rope, ViewerIO = BEGIN OPEN IO, DB; INT: TYPE = LONG INTEGER; tty: IO.STREAM; in: IO.STREAM; mySeg: DB.Segment = $Test; Person, Frog, Thing: Domain; Friend: Relation; friendOf, friendIs: Attribute; Phone: Relation; phoneOf, phoneIs: Attribute; ageProp, heightProp: Attribute; wsh, harry, mark, nori: --Person-- Entity; george: --Frog-- Entity; rock, pebble: --Thing-- Entity; myName: ROPE ← "Rick Cattell"; myExt: REF INT← NEW[INT ← 4466]; Initialize: PROC = BEGIN tty.Put[rope["Defining data dictionary..."], char[CR]]; -- Declare domains and make Persons and Frogs be subtypes of Things: Person← DeclareDomain["Person", mySeg]; Thing← DeclareDomain["Thing", mySeg]; Frog← DeclareDomain["Frog", mySeg]; DeclareSubType[of: Thing, is: Person]; DeclareSubType[of: Thing, is: Frog]; -- Declare phone age and height property of Things ageProp← DeclareProperty["Age", Thing, IntType, mySeg]; heightProp← DeclareProperty["Height", Thing, RopeType, mySeg]; -- Declare Friend relation between Persons Friend← DeclareRelation["Friend", mySeg]; friendOf← DeclareAttribute[Friend, "of", Person]; friendIs← DeclareAttribute[Friend, "is", Person]; -- Declare Phone relation between Persons and integers Phone← DeclareRelation["Phone", mySeg]; phoneOf← DeclareAttribute[Phone, "of", Person]; phoneIs← DeclareAttribute[Phone, "is", IntType]; []← DeclareIndex[Phone, LIST[phoneIs], NewOrOld]; END; InsertData: PROC = BEGIN t: Relship; rick: Entity; tty.Put[rope["Creating data..."], char[CR]]; harry← DeclareEntity[Person, "Harry Q. Bovik"]; mark← DeclareEntity[Person, "Mark Brown"]; rick← DeclareEntity[Person, myName]; nori← DeclareEntity[Person]; ChangeName[nori, "Nori Suzuki"]; -- Data can be assigned with SetP, SetF, or DeclareRelship's initialization list: []← SetP[harry, phoneIs, I2V[4999]]; []← SetP[mark, phoneIs, I2V[4464]]; []← SetP[nori, phoneIs, I2V[4425]]; []← SetP[rick, phoneIs, I2V[4466]]; []← SetP[rick, heightProp, S2V["medium"]]; t← DeclareRelship[Friend]; SetF[t, friendOf, rick]; SetF[t, friendIs, harry]; []← DeclareRelship[Friend, LIST[[friendOf, nori], [friendIs, harry]]]; END; InsertMoreData: PROCEDURE = BEGIN t: Relship; rick: Entity; ok: BOOL← FALSE; tty.Put[rope["\nCreating more data..."], char[CR]]; -- Create some new entities and fetch old one (rick) wsh← DeclareEntity[Person]; rick← DeclareEntity[Person, "Rick Cattell", OldOnly]; rock← DeclareEntity[Thing, "Harry the rock"]; pebble← DeclareEntity[Thing, "Fred the pebble"]; george← DeclareEntity[Frog, "George the frog"]; []← DeclareEntity[Frog, "Larry the frog"]; -- Use SetP to assign names and heights ChangeName[wsh, "Willie-Sue H"]; []← SetP[wsh, heightProp, S2V["medium"]]; []← SetP[mark, heightProp, S2V["taller"]]; []← SetP[rock, heightProp, S2V["big"]]; []← SetP[pebble, heightProp, S2V["little"]]; []← SetP[george, heightProp, S2V["little"]]; -- Check that Person can't be friend of frog t← DeclareRelship[Friend]; SetF[t, friendOf, rick]; SetF[t, friendIs, george ! DB.Error => TRUSTED {IF code=MismatchedAttributeValueType THEN {ok ← TRUE; CONTINUE}}]; IF NOT ok THEN ERROR; END; DestroySomeData: PROCEDURE = -- Destroy one person entity and all frog entities BEGIN flag: BOOL← FALSE; tty.Put[char[CR], rope["Deleting some data: Rick and all the frogs..."], char[CR]]; DestroyEntity[DeclareEntity[Person, "Rick Cattell", OldOnly]]; DestroyDomain[Frog]; END; PrintPeople: PROC = -- Use DomainSubset with no constraints to enumerate all Persons BEGIN person: -- PersonDomain -- Entity; es: EntitySet; lint: LONG INTEGER; tty.PutF["\nPerson Domain:\n\n"]; tty.Put[rope["Name Phone"], char[CR]]; es← DomainSubset[Person]; WHILE (person← NextEntity[es])#NIL DO tty.Put[rope[GetName[person]], char[TAB]]; lint← V2I[GetP[person, phoneIs]]; tty.Put[int[lint], char[CR]]; ENDLOOP; ReleaseEntitySet[es]; END; PrintEverything: PROCEDURE = -- Use DomainSubset to enumerate all Things (includes Frogs and Persons). -- Print "unknown" if height field is null string. BEGIN thing: -- Thing -- Entity; es: EntitySet; r: ROPE; tty.PutF["\nThings:\n\n"]; tty.PutF["Type Name Height\n"]; es← DomainSubset[Thing]; WHILE (thing← NextEntity[es])#NIL DO tty.Put[rope[GetName[DomainOf[thing]]], char[TAB]]; tty.Put[rope[GetName[thing]], char[TAB]]; r← V2S[GetP[thing, heightProp]]; tty.Put[rope[IF r.Length[]=0 THEN "[unknown]" ELSE r], char[CR]]; ENDLOOP; ReleaseEntitySet[es]; END; PrintCSLPhones: PROC = -- Use RelationSubset to enumerate phones between 4400 and 4500 BEGIN rs: RelshipSet; r: Relship; tty.PutF["\nPhone numbers between 4400 and 4499:\n"]; tty.PutF["Name Phone\n"]; rs← RelationSubset[Phone, LIST[[phoneIs, I2V[4400], I2V[4499]]], Last]; UNTIL (r← PrevRelship[rs])=NIL DO tty.PutF["%g %g\n", rope[GetFS[r, phoneOf]], rope[GetFS[r, phoneIs]] ]; ENDLOOP; ReleaseRelshipSet[rs]; END; PrintFriends: PROC = -- Use RelationSubset to enumerate friends of Harry BEGIN friendRS: --Friend-- Relship; friendName: --Person-- ROPE; rs: RelshipSet; tty.Put[char[CR], rope["Harry's friends:"], char[CR]]; rs← RelationSubset[Friend, LIST[[friendIs, harry]]]; WHILE (friendRS← NextRelship[rs])#NIL DO friendName← GetFS[friendRS, friendOf]; tty.Put[rope[friendName], rope[" "], char[CR]]; ENDLOOP; ReleaseRelshipSet[rs]; END; DoIt: PROC = { [in, tty]← ViewerIO.CreateViewerStreams["VLTest1Impl.log"]; tty.PutF["Creating database...\n"]; DB.Initialize[]; DB.DeclareSegment["[Luther.Alpine]<Cattell.pa>Test.segment", mySeg]; DB.EraseSegment[mySeg]; DB.OpenTransaction[mySeg]; Initialize[]; tty.PutF["Type a character to proceed...\n"]; []← in.GetChar[]; InsertData[]; PrintPeople[]; PrintCSLPhones[]; PrintFriends[]; InsertMoreData[]; PrintEverything[]; DestroySomeData[]; PrintEverything[]; tty.PutF["\n\nDone.\n"]; CloseTransaction[TransactionOf[mySeg]]; tty.Close[]; }; DoIt[] END.