-- File: PhoneRegistryImpl.mesa
-- Implements: PhoneRegistry operations to create and query whitepages database
-- Last edited by:
-- Cattell, January 16, 1984 3:17 pm
-- Elabbadi, August 4, 1983 12:50 pm
DIRECTORY
DB,
DBQ,
FS USING[StreamOpen, Error],
IO,
NutOps USING[SetUpSegment],
PhoneRegistry,
TiogaOps USING [StepForward, SetNodeFormat, Ref],
TiogaExtraOps USING [GetFile,PutFile, FreeTree],
UserCredentials USING[Get],
ViewerIO USING[CreateViewerStreams],
Rope
;
PhoneRegistryImpl: CEDAR PROGRAM
IMPORTS DB, DBQ, IO, FS, NutOps, PhoneRegistry, Rope,
TiogaExtraOps, TiogaOps, UserCredentials, ViewerIO
EXPORTS PhoneRegistry
= BEGIN
OPEN DB, Rope;
-- Global variables for accessing the database
PersonDomain: DB.Domain; --the domain of persons; each entity has a unique name
--formed from the concat of lastname,firstname<rName>
NameRelation: DB.Relation; -- The tuples in the relation have the structure:
--NameRelation[ Person: PersonDomain,
--last: ROPE, LastNameSoundex: ROPE ,
--first:ROPE, FirstNameSoundex: ROPE]
PersonAttrNameRel: DB.Attribute; --The person entity's unique name( pointer)
LastNameAttr: DB.Attribute;
LastNameSoundexAttr: DB.Attribute;
FirstNameAttr: DB.Attribute;
FirstNameSoundexAttr: DB.Attribute;
RNameRelation: DB.Relation; --The relation containing the rnames of persons
--The tuples in the relation have the structure:
--RNameRelation[Person: PersonDomain,
--RName:ROPE, RNameSoundex: Rope]
PersonAttrRNameRel: DB.Attribute;
RNameAttr: DB.Attribute;
RNameSoundexAttr: DB.Attribute;
PhoneRelation: DB.Relation; --The relation containing the phones of a Person.
--The tuples in the relation have the structure:
--PhoneRelation[ Person: PersonDomain,
--Phone: ROPE, PhoneKind: ROPE]
PersonAttrPhoneRel: DB.Attribute;
PhoneAttr: DB.Attribute;
PhoneKindAttr: DB.Attribute;
segment: ATOM;
Failed: PUBLIC ERROR[why: PhoneRegistry.Failure, reason: Rope.ROPE] = CODE;
-- Accessing Phone database
Initialization: PUBLIC PROC ={
-- Set up the database with:
-- Domain: Person,
-- Relations: Phone, Name.
-- on both private and public segments.
in, out: IO.STREAM;
localFile: ROPE← Rope.Cat["[Luther.Alpine]<", UserCredentials.Get[].name, ">Squirrel.segment"];
[in, out] ← ViewerIO.CreateViewerStreams["PhoneRegistryLog"];
DB.Initialize[];
IF NOT NutOps.SetUpSegment[segmentFile: localFile, seg: $Squirrel].success THEN
out.PutF["Can\'t open %g", IO.rope[localFile]];
IF NOT NutOps.SetUpSegment[ -- Will open for writing if user so priviledged
segmentFile: "[Luther.Alpine]<Grapenut>Grapenut.segment", seg: $Grapenut].success THEN
out.PutF["Can\'t open %[Luther.Alpine]<Grapenut>Grapenut.segment"];
-- If writing to public segment, put the following in reverse order
InitPublic[];
InitPrivate[];
};
GetPhoneNumber: PUBLIC PROC[
rName: Rope.ROPE← NIL, last: Rope.ROPE← NIL, first: Rope.ROPE← NIL,
phoneKind: Rope.ROPE← NIL] RETURNS [Rope.ROPE] = {
-- If RName/last name/firstname exists return associated PhoneNumber
-- of the requested type. Return "None" if none exist.
-- At Least one of rName, last, first must not be NIL
-- If more than one person exists corresponding to given RName/last name/firstname
-- (in both segments) return list of persons names.
-- Give all phone numbers associated with a person irrispective of duplication.
phoneRelship: --phone--DB.Relship;
t: DB.Relship;
nextRel: DB.Relship;
PhoneNumbers: DB.RelshipSet;
probablePersons: DB.RelshipSet; --set of candidate persons associated with given name
constrain: DB.AttributeValueList;
phone: Rope.ROPE←NIL;
p: DB.Entity;
person: DB.Entity;
name: Rope.ROPE;
personAttr: DB.Attribute;
soundexAttr: DB.Attribute;
attr: DB.Attribute;
rel: DB.Relation;
segName: Rope.ROPE;
list, uniqueList: LIST OF DB.Entity;
length: INT;
SegOf: PROC[phoneRelship: DB.Relship]RETURNS[Rope.ROPE]={
IF DB.SegmentOf[phoneRelship] = $Squirrel THEN RETURN[" Private"]
ELSE RETURN[" Public"];
};
SELECT TRUE FROM
rName#NIL => {
probablePersons ← DBQ.QRelationSubset[RNameRelation,
LIST[ AttributeValue[RNameAttr, S2V[rName]]]];
attr ← PersonAttrRNameRel
};
last#NIL, first#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation, LIST[
AttributeValue[LastNameAttr, S2V[last]], AttributeValue[FirstNameAttr, S2V[first]]]];
attr ← PersonAttrNameRel
};
last#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation, LIST[
AttributeValue[LastNameAttr, S2V[last]]]];
attr ← PersonAttrNameRel
};
first#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation, LIST[
AttributeValue[FirstNameAttr, S2V[first]]]];
attr ← PersonAttrNameRel
};
ENDCASE => ERROR;
t← DBQ.QNextRelship[probablePersons];
IF t # NIL THEN{
-- Eliminate same person but in different segments
p← V2E[DBQ.QGetF[t, attr]];
list← LIST[p];
WHILE (nextRel ← DBQ.QNextRelship[probablePersons]) #NIL DO
list← CONS[V2E[DBQ.QGetF[nextRel, attr]], list] ENDLOOP;
[uniqueList, length]← UniqueList[list];
IF length > 1 THEN RETURN[RopeList[uniqueList]];
person← V2E[DBQ.QGetF[t, attr]];
IF (Rope.Equal[phoneKind, "All"] OR Rope.Equal[phoneKind, NIL])
THEN constrain← LIST[ AttributeValue[PersonAttrPhoneRel, person]]
ELSE constrain← LIST[ AttributeValue[PersonAttrPhoneRel, person],
AttributeValue[PhoneKindAttr, S2V[phoneKind]]];
PhoneNumbers← DBQ.QRelationSubset[PhoneRelation, constrain];
IF (phoneRelship←DBQ.QNextRelship[PhoneNumbers] )= NIL THEN RETURN["None"];
-- Only one person exists=> find his phonenumbers
segName←SegOf[phoneRelship];
phone�t[V2S[DBQ.QGetF[phoneRelship, PhoneAttr]],
" ",
V2S[DBQ.QGetF[phoneRelship, PhoneKindAttr]],
segName
];
WHILE ( phoneRelship ← DBQ.QNextRelship[PhoneNumbers])#NIL DO
segName←SegOf[phoneRelship];
phone�t[" ",
phone,
V2S[DBQ.QGetF[phoneRelship,PhoneAttr]],
" ",
V2S[DBQ.QGetF[phoneRelship,PhoneKindAttr]],
segName];
ENDLOOP;
DB.ReleaseRelshipSet[PhoneNumbers];
RETURN [phone]
}
ELSE {
-- Wrong information try soundex alternatives
SELECT TRUE FROM
last#NIL => {name ← last;
soundexAttr ← LastNameSoundexAttr;
personAttr ← PersonAttrNameRel;
rel← NameRelation};
first#NIL => {name ← first;
soundexAttr ← FirstNameSoundexAttr;
personAttr ← PersonAttrNameRel;
rel← NameRelation};
rName#NIL => {name ← rName;
soundexAttr ← RNameSoundexAttr;
personAttr ← PersonAttrRNameRel;
rel← RNameRelation};
ENDCASE => ERROR;
RETURN[SuggestNames[name, personAttr, soundexAttr, rel]]
}
};
UniqueList: PROC[list: LIST OF Entity] RETURNS[list1: LIST OF Entity, length: INT]={
-- Given list generate list1 with no multiple entries, return in length the number
-- of entities in list1.I am using an O(n square) algorithm for simplicity. A more efficient
-- way would perform sorting and then check for duplicates.
node, n: DB.Entity;
l: LIST OF Entity;
unique: BOOL;
length← 0;
list1← NIL;
IF list = NIL THEN RETURN[list1, length];
DO
node← list.first;
unique← TRUE;
IF (l← list.rest) #NIL THEN {
DO
n← l.first;
IF Rope.Equal[DB.NameOf[node], DB.NameOf[n]] THEN unique← FALSE;
IF (l← l.rest ) = NIL THEN EXIT;
ENDLOOP;
};
IF unique THEN{
list1←CONS[node, list1];
length← length+1;
};
IF (list←list.rest ) = NIL THEN EXIT;
ENDLOOP;
RETURN[list1, length]
};
RopeList: PROC[list: LIST OF Entity] RETURNS[names: Rope.ROPE]={
node: DB.Entity;
names← NIL;
FOR list← list, list.rest UNTIL list = NIL DO
node← list.first;
names← Rope.Cat[names, " ", DB.NameOf[node]]
ENDLOOP
};
GetName: PUBLIC PROC[rName:Rope.ROPE] RETURNS [Rope.ROPE] = {
-- If RName exists return associated Name.
-- Return "None" if none exist.
-- If RName doesn't exist return suggested names using soundex code.
name: Rope.ROPE;
nameSet: DB.RelshipSet;
nameRelship: DB.Relship;
constrain: DB.AttributeValueList;
firstTime: BOOL ← TRUE;
personRelship: DB.Entity;
person: DB.Entity;
segName: Rope.ROPE;
list, uniqueList: LIST OF DB.Entity;
length: INT;
personRelship← DBQ.QDeclareRelship[
RNameRelation, LIST[AttributeValue[RNameAttr, S2V[rName]]], OldOnly];
IF personRelship#NIL THEN {
person ← V2E[DBQ.QGetF[personRelship,PersonAttrRNameRel]];
constrain← LIST[ AttributeValue[PersonAttrNameRel, person]];
nameSet ← DBQ.QRelationSubset[ NameRelation, constrain];
WHILE ( nameRelship ← DBQ.QNextRelship[nameSet])#NIL DO
list←CONS[V2E[DBQ.QGetF[nameRelship, PersonAttrNameRel]], list];
ENDLOOP;
[uniqueList, length]← UniqueList[list];
FOR uniqueList← uniqueList, uniqueList.rest UNTIL uniqueList=NIL DO
person ← uniqueList.first;
IF DB.SegmentOf[person] = $Squirrel THEN segName ← " Private"
ELSE segName ← " Public";
IF firstTime THEN firstTime←FALSE ELSE name𡤌oncat[name," "];
name�t[name, DB.NameOf[person], segName];
ENDLOOP;
DB.ReleaseRelshipSet[nameSet];
RETURN[name]
}
ELSE
RETURN[SuggestNames[rName, PersonAttrRNameRel, RNameSoundexAttr, RNameRelation]]
};
GetRName: PUBLIC PROC[last: Rope.ROPE←NIL, first: Rope.ROPE← NIL] RETURNS [Rope.ROPE] = {
-- If last/first names exist return associated RName
-- Return "None" if no RName exists.
-- Suggest other alternative names if given info is not accurate.
name: Rope.ROPE;
rNameRelship: DB.Relship;
probablePersons: RelshipSet;
constrain: AttributeValueList;
firstTime: BOOL ← TRUE;
person: DB.Entity;
entityName: Rope.ROPE;
attr: DB.Attribute;
t: DB.Relship;
nextRel: DB.Relship;
suggestedRNames: Rope.ROPE;
segName: Rope.ROPE;
SELECT TRUE FROM
last#NIL, first#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation,LIST[
AttributeValue[LastNameAttr, S2V[last]], AttributeValue[FirstNameAttr, S2V[first]]]];
attr ← PersonAttrNameRel
};
last#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation, LIST[
AttributeValue[LastNameAttr, S2V[last]]]];
attr ← PersonAttrNameRel
};
first#NIL => {
probablePersons ← DBQ.QRelationSubset[NameRelation, LIST[
AttributeValue[FirstNameAttr, S2V[first]]]];
attr ← PersonAttrNameRel
};
ENDCASE => ERROR;
t← DBQ.QNextRelship[probablePersons];
nextRel← DBQ.QNextRelship[probablePersons];
IF nextRel#NIL THEN {
-- More than one possible person
UNTIL (nextRel ← DBQ.QNextRelship[probablePersons])#NIL DO
IF firstTime THEN{
firstTime←FALSE;
suggestedRNames ← Concat[NameOf[V2E[DBQ.QGetF[ t, attr]]]," "]}
ELSE
suggestedRNames𡤌oncat[suggestedRNames," "];
IF DB.SegmentOf[nextRel] = $Squirrel THEN segName ← "Private"
ELSE segName ← "Public";
suggestedRNames�t[
suggestedRNames,NameOf[V2E[DBQ.QGetF[nextRel, attr]]], segName];
ENDLOOP;
DB.ReleaseRelshipSet[probablePersons];
RETURN[suggestedRNames]
};
entityName ← NameOf[V2E[DBQ.QGetF[t, attr]]];
person ← DBQ.QFetchEntity[ PersonDomain, entityName, $All];
IF person#NIL THEN {
constrain← LIST[ AttributeValue[RNameRelation, person]];
rNameRelship← DBQ.QDeclareRelship[ RNameRelation, constrain];
IF rNameRelship = NIL THEN RETURN["No RName associated"];
RETURN [V2S[DBQ.QGetF[rNameRelship,RNameAttr]]]
}
ELSE
-- Try SoundexCode
SELECT TRUE FROM
last#NIL => {name ← last; attr ← LastNameSoundexAttr};
first#NIL => {name ← first; attr ← FirstNameSoundexAttr};
ENDCASE => ERROR;--shouldn't happen--
RETURN[SuggestNames[name, PersonAttrNameRel, attr, NameRelation]]
};
SuggestNames: PROC[
name: Rope.ROPE, personAttr: DB.Attribute,soundexAttr: DB.Attribute, rel: DB.Relation]
RETURNS[Rope.ROPE] = {
-- Return all names that have same soundex code as name in rel for the attribute attr.
soundexCode: Rope.ROPE;
soundexRelship: DB.Relship;
constrain: AttributeValueList;
probablePersons: RelshipSet;
suggestedNames: Rope.ROPE←NIL; --The names of probable Pesons
firstTime: BOOL;
segName: Rope.ROPE;
soundexCode← Encode[name];
constrain← LIST[ AttributeValue[soundexAttr, S2V[soundexCode]]];
probablePersons ← DBQ.QRelationSubset[ rel, constrain];
IF probablePersons = NIL THEN RETURN["No such name, Misspells checked"];
WHILE ( soundexRelship ← DBQ.QNextRelship[probablePersons])#NIL DO
IF firstTime THEN firstTime←FALSE ELSE suggestedNames𡤌oncat[suggestedNames," "];
IF DB.SegmentOf[soundexRelship] = $Squirrel THEN segName ← "Private"
ELSE segName ← "Public";
suggestedNames← Cat[
suggestedNames,
NameOf[V2E[DBQ.QGetF[soundexRelship, personAttr]]],
segName];
ENDLOOP;
DB.ReleaseRelshipSet[probablePersons];
RETURN [suggestedNames]
};
AddFileToDB: PUBLIC PROC[newList:Rope.ROPE] = {
-- Register all entries in newList in the DB. Entries have to be of the same format
-- as WhitePages.CNF is. as specified before.
-- Errors still have to be handled
OPEN IO;
stream: IO.STREAM;
header,data : Rope.ROPE;
rName,name,phone : Rope.ROPE;
in, out: IO.STREAM;
{
ENABLE{IO.EndOfStream => GOTO Out};
stream ← FS.StreamOpen[ newList
! FS.Error => ERROR PhoneRegistry.Failed[ NoInputFile, newList]];
[in, out] ← ViewerIO.CreateViewerStreams["Trace"];
DO
[header, data] ← LexicalAnalyzer[stream];
IF header = NIL THEN EXIT;
SELECT TRUE FROM
Rope.Equal[ header,"Rname"] => {
rName ← data;
--DB.MarkTransaction[DB.TransactionOf[$Grapenut]];
out.PutF[ "The Count is %g\n", IO.rope[data]];
IF NOT( CheckRNameValidity[rName] ) THEN
ERROR PhoneRegistry.Failed[ NoSuchRName, rName];
};
Rope.Equal[ header, "Name"] => {
name ← data;
[]←RegisterPerson[name, rName];
};
Rope.Equal[ header, "Office Number"] => {
phone ← data;
IF (CheckPhoneValidity[phone]) THEN RegisterPhone[rName, name, phone, header]
ELSE
ERROR PhoneRegistry.Failed[NoSuchPhone, phone];
};
Rope.Equal[ header, "Office Public Number"] => {
phone ← data;
IF (CheckPhoneValidity[phone]) THEN RegisterPhone[rName,name,phone,header]
ELSE
ERROR PhoneRegistry.Failed[NoSuchPhone, phone];
};
ENDCASE =>
NULL;
ENDLOOP;
EXITS
Out => NULL;
};
IF stream # NIL THEN stream.Close[];
--DB.CloseTransaction[DB.TransactionOf[$Squirrel]]
};
LexicalAnalyzer: PROC[
stream: IO.STREAM] RETURNS[header: Rope.ROPE ← NIL, data: Rope.ROPE] ={
-- Analyse a stream that is of the form header: data
-- and return both header and data. Any line (a sequence of characters ending with a CR)
-- containing no : is disregarded. No checking of validity of header is done. Any : following
-- the first one is not taken into consideration.
separator:Rope.ROPE;
begin: INT;
headerOrData: Rope.ROPE;
[]← IO.SkipWhitespace[stream];
WHILE header = NIL DO
headerOrData ← IO.GetTokenRope[stream, TokenFinder].token;
begin ← Rope.SkipOver[s: headerOrData, skip: " "];
headerOrData ← Rope.Substr[headerOrData, begin, Rope.Length[headerOrData] - begin + 1];
IF headerOrData = NIL THEN RETURN[NIL,NIL];
separator ← IO.GetTokenRope[stream, TokenFinder].token;
IF Rope.Equal[separator, ":"] THEN header ← headerOrData;
ENDLOOP;
[]← IO.SkipWhitespace[stream];
data ← IO.GetLineRope[stream];
RETURN[header, data]
};
TokenFinder: IO.BreakProc = {
RETURN[ IF char = IO.CR OR char= ': THEN break ELSE other ] };
MakeList: PUBLIC PROC[
lowLName, highLName: Rope.ROPE← NIL, phoneKind: Rope.ROPE← "All"] = {
-- Make a list of LastNames with their associated phone numbers of the kind noted,
-- in the specified range from lowRName to highRName in lexicographical order.
-- If no range is specified list the entire phone registry particular order.
-- If no phone kind is given list all phones associated.
root: TiogaOps.Ref;
nameRelshipSet: DB.RelshipSet;
personRelship: DB.Relship;
first, last: Rope.ROPE;
phone: Rope.ROPE;
listStream: IO.STREAM← FS.StreamOpen[fileName: "PersonList", accessOptions: $create];
nameRelshipSet ← DBQ.QRelationSubset[NameRelation,
LIST[AttributeValue[LastNameAttr,S2V[lowLName], S2V[highLName]]] ];
IF nameRelshipSet = NIL
THEN listStream.PutF["\n%-g",IO.rope[ "NO RNames in the specified range"]];
WHILE (personRelship← DBQ.QNextRelship[nameRelshipSet]) # NIL DO
last ← V2S[DBQ.QGetF[personRelship,LastNameAttr]];
first ← V2S[DBQ.QGetF[personRelship,FirstNameAttr]];
phone← GetPhoneNumber[NIL,last, first, phoneKind];
listStream.PutF["\n%g %g",
IO.rope[NameOf[V2E[DBQ.QGetF[personRelship, PersonAttrNameRel]]]], IO.rope[phone]];
ENDLOOP;
DB.ReleaseRelshipSet[nameRelshipSet];
IO.Close[listStream];
root← TiogaExtraOps.GetFile["PersonList"];
FOR r:TiogaOps.Ref← TiogaOps.StepForward[root], TiogaOps.StepForward[r]
UNTIL r = NIL OR r = root DO
TiogaOps.SetNodeFormat["table2",r];
ENDLOOP;
TiogaExtraOps.PutFile["PersonList", root];
TiogaExtraOps.FreeTree[root];
};
InitPrivate: PROC = {
-- Set up the private DB, using standard $Squirrel segment
PersonDomain ← DeclareDomain[ "Person", $Squirrel];
NameRelation ← DeclareRelation[ "name-info", $Squirrel];
PersonAttrNameRel ← DeclareAttribute[NameRelation, "Person", PersonDomain];
LastNameAttr ← DeclareAttribute[NameRelation, "last", RopeType];
LastNameSoundexAttr ← DeclareAttribute[NameRelation, "last-soundex", RopeType];
FirstNameAttr ← DeclareAttribute[NameRelation, "first", RopeType];
FirstNameSoundexAttr← DeclareAttribute[NameRelation, "first-soundex", RopeType];
RNameRelation ← DeclareRelation[ "RName", $Squirrel];
PersonAttrRNameRel ← DeclareAttribute[RNameRelation, "of", PersonDomain];
RNameAttr ← DeclareAttribute[RNameRelation, "is", RopeType];
RNameSoundexAttr← DeclareAttribute[RNameRelation, "soundex", RopeType];
PhoneRelation ← DeclareRelation[ "phone", $Squirrel];
PersonAttrPhoneRel← DeclareAttribute[PhoneRelation, "of", PersonDomain];
PhoneAttr ← DeclareAttribute[PhoneRelation, "is", RopeType];
PhoneKindAttr �lareAttribute[PhoneRelation, "at", RopeType];
segment ← $Squirrel;
};
InitPublic: PROC = {
-- Set up Public DB, $Grapenut
PersonDomain ← DeclareDomain[ "Person", $Grapenut];
NameRelation ← DeclareRelation[ "name-info", $Grapenut];
PersonAttrNameRel ← DeclareAttribute[NameRelation, "Person", PersonDomain];
LastNameAttr ← DeclareAttribute[NameRelation, "last", RopeType];
LastNameSoundexAttr ← DeclareAttribute[NameRelation, "last-soundex", RopeType];
FirstNameAttr ← DeclareAttribute[NameRelation, "first", RopeType];
FirstNameSoundexAttr← DeclareAttribute[NameRelation, "first-soundex", RopeType];
RNameRelation ← DeclareRelation[ "RName", $Grapenut];
PersonAttrRNameRel ← DeclareAttribute[RNameRelation, "of", PersonDomain];
RNameAttr ← DeclareAttribute[RNameRelation, "is", RopeType];
RNameSoundexAttr← DeclareAttribute[RNameRelation, "soundex", RopeType];
PhoneRelation ← DeclareRelation[ "phone", $Grapenut];
PersonAttrPhoneRel← DeclareAttribute[PhoneRelation, "of", PersonDomain];
PhoneAttr ← DeclareAttribute[PhoneRelation, "is", RopeType];
PhoneKindAttr �lareAttribute[PhoneRelation, "at", RopeType];
segment ← $Grapenut;
};
RegisterPerson: PUBLIC PROC [
name: Rope.ROPE ← NIL, rName: Rope.ROPE ← NIL] RETURNS[person: DB.Entity]= {
-- If Rname exists check first and last names , update them to new values and
-- change Person Entity name. If it doesn't exist, check if last, first names exist,
-- check and create person if required . If rName specified override any existing entries.
last, first: Rope.ROPE;
personRelship: DB.Relship;
[last, first] ← ParseName[name];
IF rName # NIL THEN {
personRelship ← DB.DeclareRelship[
RNameRelation, LIST[AttributeValue[RNameAttr, S2V[rName]]], OldOnly];
IF personRelship#NIL THEN --person exists verify given info
{person ← V2E[DBQ.QGetF[personRelship, PersonAttrRNameRel]];
IF ~Rope.Equal[name, NIL] THEN VerifyPerson[person, rName, last, first]
}
ELSE -- Person doesn't exist=> create him
person← InternalRegisterPerson[rName, last, first];
RETURN
}
ELSE{-- Now the names turn
personRelship ← DeclareRelship[
NameRelation,
LIST[
AttributeValue[LastNameAttr, S2V[last]], AttributeValue[FirstNameAttr, S2V[first]]],
OldOnly];
IF personRelship # NIL THEN
RETURN -- person exists and no changes
ELSE -- person doesn't exist => create him
[]← InternalRegisterPerson[rName, last, first];
};
RETURN
};
InternalRegisterPerson: PROC[
rName: Rope.ROPE, last: Rope.ROPE, first: Rope.ROPE] RETURNS[Entity] = {
entityName: Rope.ROPE;
person:DB.Entity;
entityName ← FormEntityName[rName, last, first];
person← DeclareEntity[PersonDomain, entityName];
IF rName#NIL THEN InternalRegisterRName[person, rName];
IF last#NIL OR first# NIL THEN InternalRegisterName[person, last, first];
DB.MarkTransaction[DB.TransactionOf[segment]];
RETURN[person]
};
InternalRegisterRName: PROC[
person: Entity, rName: Rope.ROPE] ={
-- Register in RNameRelation the Person with the appropriate RName
avList: AttributeValueList;
rNameSoundexCode: Rope.ROPE;
IF ~CheckRNameValidity[rName] THEN ERROR PhoneRegistry.Failed[ NoSuchRName, rName];
rNameSoundexCode ← Encode[rName];
avList ← LIST[
AttributeValue[PersonAttrRNameRel, person],
AttributeValue[RNameAttr, S2V[rName]],
AttributeValue[RNameSoundexAttr, S2V[rNameSoundexCode]]];
[]�lareRelship[RNameRelation, avList ];
};
InternalRegisterName: PROC[person: Entity, last: Rope.ROPE, first: Rope.ROPE] ={
-- Register in NameRelation the Person with the appropriate last and first names
avList: AttributeValueList;
lastSoundexCode: Rope.ROPE;
firstSoundexCode: Rope.ROPE;
IF last#NIL THEN lastSoundexCode ← Encode[last];
IF first#NIL THEN firstSoundexCode ← Encode[first];
avList ← LIST[
AttributeValue[PersonAttrNameRel, person],
AttributeValue[LastNameAttr, S2V[last]],
AttributeValue[FirstNameAttr, S2V[first]],
AttributeValue[LastNameSoundexAttr, S2V[lastSoundexCode]],
AttributeValue[FirstNameSoundexAttr, S2V[firstSoundexCode]] ];
[]�lareRelship[NameRelation, avList ];
};
InternalRegisterPhone: PROC[person: Entity, phone: Rope.ROPE, kind: Rope.ROPE] ={
-- Register in NameRelation the Person with the appropriate last and first names
avList: AttributeValueList ← LIST[
AttributeValue[PersonAttrPhoneRel, person],
AttributeValue[PhoneAttr, S2V[phone]],
AttributeValue[PhoneKindAttr, S2V[kind]] ];
[]�lareRelship[PhoneRelation, avList ];
};
FormEntityName: PROC[
rName: Rope.ROPE, last:Rope.ROPE, first: Rope.ROPE] RETURNS[Rope.ROPE]={
IF rName#NIL THEN
{IF ~CheckRNameValidity[rName] THEN
ERROR PhoneRegistry.Failed[ NoSuchRName, rName];
rName ← Cat["<", rName, ">"]};
IF last#NIL AND first#NIL THEN RETURN[Cat[ last, ",", first, rName]]
ELSE RETURN[Cat[last,first,rName]];
};
VerifyPerson: PROC[person: Entity, rName:Rope.ROPE, last: Rope.ROPE, first: Rope.ROPE] ={
-- Verify that this person has the given last and first names. If he doesn't override
-- existing information.
relship: Relship;
avList: AttributeValueList;
regLast, regFirst: Rope.ROPE;
newName: Rope.ROPE;
avList ← LIST[AttributeValue[PersonAttrNameRel, person]];
relship←DBQ.QDeclareRelship[NameRelation, avList, OldOnly ];
IF relship # NIL THEN {
regLast ← V2S[DB.GetF[ relship, LastNameAttr]];
regFirst ← V2S[DB.GetF[ relship, FirstNameAttr]];
IF Rope.Equal[regLast, last] AND Rope.Equal[regFirst, first] THEN RETURN
};
newName ← FormEntityName[rName, last, first];
ChangeName[person, newName];
IF last#NIL OR first# NIL THEN InternalRegisterName[person, last, first];
DB.MarkTransaction[DB.TransactionOf[segment]];
};
ParseName: PROC[
name: Rope.ROPE] RETURNS[last: Rope.ROPE , first: Rope.ROPE ] ={
-- Name is given in the format .. last, first ..any information right of the , is
-- concidered part of the first name( this should be changed according to application).
letter: Rope.ROPE;
firstHalf: BOOL ← TRUE;
position: INT;
last← NIL;
first←NIL;
FOR position IN [0..Rope.Length[name]) DO
letter← Rope.Substr[name, position,1];
IF Rope.Equal[letter , "," ]THEN firstHalf ← FALSE
ELSE IF firstHalf THEN last ← Concat[last, letter]
ELSE first ← Concat[first, letter]
ENDLOOP;
RETURN[last, first];
};
RegisterPhone: PUBLIC PROC[
rName: Rope.ROPE←NIL, name: Rope.ROPE←NIL, phone: Rope.ROPE, phoneKind: Rope.ROPE] = {
-- Create person with given RName if one doesn't already exist.
-- Register Phone, and its type in PhoneRelation.
-- Check validity of Phone Number
person: DB.Entity ← RegisterPerson[ name, rName];
IF (CheckPhoneValidity[phone]) THEN InternalRegisterPhone[person, phone, phoneKind]
ELSE ERROR PhoneRegistry.Failed[NoSuchPhone, phone];
};
Encode: PROC[rName: Rope.ROPE] RETURNS[soundexCode: Rope.ROPE]= {
-- Encode the given rName using the Soundex mapping and return it in soundexCode.
-- ref Knuth Vol.3
position: INT;
letter: CHAR;
number, previousNumber: Rope.ROPE;
Code: PROC [letter: CHAR] RETURNS[Rope.ROPE] = {
SELECT letter FROM
'b => RETURN["1"];
'f => RETURN ["1"];
'p => RETURN ["1"];
'v => RETURN["1"];
'c => RETURN["2"];
'g => RETURN["2"];
'j => RETURN["2"];
'k => RETURN["2"];
'q => RETURN["2"];
's => RETURN["2"];
'x => RETURN["2"];
'z => RETURN["2"];
'd => RETURN["3"];
't => RETURN["3"];
'l => RETURN["4"];
'm => RETURN["5"];
'n => RETURN["5"];
'r => RETURN["6"];
ENDCASE => RETURN["0"];
};
soundexCode ← Rope.Substr[rName, 0, 1];
previousNumber ← Code[soundexCode.Fetch[0]];
FOR position IN [1..Rope.Length[rName]) DO
letter← Rope.Fetch[rName, position];
number ← Code[letter];
IF number.Equal[previousNumber] THEN number ← "0";
IF NOT number.Equal["0"] THEN
{soundexCode← Concat[soundexCode, number]; previousNumber← number};
ENDLOOP;
IF Rope.Length[soundexCode] >= 4 THEN RETURN[Rope.Substr[soundexCode, 0, 4]];
FOR position IN [Rope.Length[soundexCode]..4) DO
soundexCode ← Rope.Concat[soundexCode, "0"];
ENDLOOP;
RETURN[soundexCode];
};
CheckRNameValidity: PROC[rName:Rope.ROPE] RETURNS[BOOL] = {
-- No Checking is done now, the code is here for that purpose, but what do we
-- do if there is an error.
RETURN[TRUE]
-- Allowed: GVNames.StampInfo ← individual;
-- IF ( GVNames.CheckStamp[rName] = allowed )
-- THEN RETURN[TRUE] ELSE RETURN[FALSE];
};
CheckPhoneValidity: PROC[phone:Rope.ROPE] RETURNS[BOOL] = {
-- Check if numbers have "8" or "9" followed by 7 or 10 digits.
-- No Checking is done now, the code is here for that purpose, but what do we
-- do if there is an error
RETURN[TRUE];
--numberOfDigits: INT ← 0;
--position: INT;
--FOR position IN [0..Rope.Length[phone])
--DO
--IF Rope.Digit[Rope.Fetch[phone,position] ]
-- THEN numberOfDigits ← numberOfDigits + 1;
-- ENDLOOP;
--SELECT TRUE FROM
--Rope.Fetch[phone] = '8 =>IF numberOfDigits = 8 OR
-- numberOfDigits = 11 THEN RETURN[TRUE]
-- ELSE RETURN[FALSE];
--Rope.Fetch[phone] = '9 =>IF numberOfDigits = 8 OR
-- numberOfDigits = 11 THEN RETURN[TRUE]
-- ELSE RETURN[FALSE];
-- ENDCASE => RETURN[FALSE];
};
END.