DIRECTORY
Atom USING [MakeAtom],
Commander USING [CommandProc, Register],
FS USING [ComponentPositions, ExpandName],
IO USING [BreakProc, STREAM, RIS, GetTokenRope, IDProc, EndOfStream, PutF, atom, rope, int, PutRope],
LoganBerry USING [Entry, OpenDB, nullDB, SchemaInfo, Attribute, Error, AttributeType, AttributeValue, Open, Describe],
LoganQuery USING [AttributePatterns, AttributePattern, AttributePatternRec, ComplexCursor, WriteAttributePatterns, QueryEntries, NextEntry],
Rope USING [Concat, Equal, Find, Fetch, Length, ROPE, Substr],
UserProfile USING [Token]
;

WPCommands: CEDAR PROGRAM
IMPORTS Atom, Commander, FS, IO, LoganBerry, LoganQuery, Rope, UserProfile 
~ BEGIN

ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;

Entry: TYPE ~ LoganBerry.Entry;
Cursor: TYPE ~ LoganQuery.ComplexCursor;
AttributePattern: TYPE ~ LoganQuery.AttributePattern;
AttributePatternRec: TYPE ~ LoganQuery.AttributePatternRec;
AttributePatterns: TYPE ~ LoganQuery.AttributePatterns;

OpenDBs: TYPE ~ LIST OF DBInfo;
DBInfo: TYPE = REF DBInfoRec;
DBInfoRec: TYPE = RECORD[
db: LoganBerry.OpenDB _ LoganBerry.nullDB,  -- open database handle
schema: LoganBerry.SchemaInfo _ NIL,  -- database schema
shortname: Rope.ROPE _ NIL,  -- short name for database
selected: BOOLEAN _ TRUE  -- whether or not database is selected for browsing
];
ParseQuery: PROC [r: ROPE] RETURNS [patterns: AttributePatterns _ NIL, dbs: OpenDBs _ NIL, searchAll: BOOLEAN _ FALSE, wantHome: BOOLEAN _ FALSE, placeCall: BOOLEAN _ TRUE, errMsg: ROPE _ NIL] ~ {
NonBlank: IO.BreakProc ~ {
RETURN[SELECT char FROM
IN [0C .. ' ] => sepr,
ENDCASE => other]
};
s: STREAM _ IO.RIS[r];
token: ROPE;
DO  -- until EndOfStream
token _ IO.GetTokenRope[stream: s, breakProc: NonBlank ! IO.EndOfStream => EXIT].token;
SELECT TRUE FROM
Rope.Equal[s1: "?", s2: token, case: FALSE] => placeCall _ FALSE;
Rope.Equal[s1: "some", s2: token, case: FALSE] => searchAll _ FALSE;
Rope.Equal[s1: "all", s2: token, case: FALSE] => searchAll _ TRUE;
Rope.Equal[s1: "at", s2: token, case: FALSE] => {
token _ IO.GetTokenRope[stream: s, breakProc: NonBlank ! IO.EndOfStream => EXIT].token;
wantHome _ Rope.Equal[s1: "home", s2: token, case: FALSE];
};
Rope.Equal[s1: "in", s2: token, case: FALSE] => {
db: DBInfo _ NIL;
token _ IO.GetTokenRope[stream: s, breakProc: NonBlank ! IO.EndOfStream => EXIT].token;
FOR d: OpenDBs _ WhitePages, d.rest WHILE d#NIL DO
IF Rope.Find[s1: d.first.schema.dbName, s2: token, case: FALSE]#-1 THEN {
db _ d.first;
EXIT;
};
ENDLOOP;
IF db=NIL THEN
db _ Open[token];
IF db#NIL THEN
dbs _ CONS[db, dbs];
};
ENDCASE => {  -- <attribute>(<filter>): <value>
a: AttributePattern _ NEW[AttributePatternRec _ [attr: [NIL, NIL], ptype: NIL]];
SELECT Rope.Fetch[base: token, index: Rope.Length[token]-1] FROM
': => {  -- type and/or ptype specified
sp: INT _ Rope.Find[s1: token, s2: "("];
ep: INT _ Rope.Find[s1: token, s2: ")"];
IF NOT (sp#-1 AND ep#-1 AND sp<ep) THEN sp _ ep _ Rope.Length[token]-2;
a.attr.type _ Atom.MakeAtom[Rope.Substr[base: token, start: 0, len: sp]];
a.ptype _ Rope.Substr[base: token, start: sp+1, len: ep-sp-1];
a.attr.value _ IO.GetTokenRope[stream: s, breakProc: NonBlank ! IO.EndOfStream => EXIT].token;
};
ENDCASE => a.attr.value _ token;
patterns _ CONS[a, patterns];
};
ENDLOOP;
};
WhitePages: OpenDBs;  -- the set of default whitepage databases

SetDefaultDatabases: PROC [directoryFiles: ROPE] RETURNS [dbs: OpenDBs] ~ {
ParseAndOpen: PROC [r: ROPE] RETURNS [d: OpenDBs] ~ {
dbname: ROPE;
s: STREAM = IO.RIS[r];
d _ NIL;
DO
dbname _ IO.GetTokenRope[s, IO.IDProc ! IO.EndOfStream => EXIT].token;
d _ CONS[Open[dbname], d];
ENDLOOP;
};
dbs _ NIL;
IF directoryFiles # NIL THEN
dbs _ ParseAndOpen[directoryFiles];
IF dbs = NIL THEN
dbs _ ParseAndOpen[UserProfile.Token[key: "Finch.WhitePagesDB"]];
WhitePages _ dbs;
};

GetDefaultDatabases: PROC [] RETURNS [dbs: OpenDBs] ~ {
IF WhitePages=NIL THEN [] _ SetDefaultDatabases[NIL];
RETURN[WhitePages];
};

GetDefaultPType: PROC [attr: LoganBerry.Attribute] RETURNS [LIST OF ROPE] ~ {
SELECT attr.type FROM
tOffice, tHome => {
IF Rope.Find[attr.value, "*"]#-1
THEN RETURN[LIST["Wildcard"]]
ELSE RETURN[LIST["Prefix"]];
};
tName, tRname, tRemarks => {
IF Rope.Find[attr.value, "*"]#-1
THEN RETURN[LIST["Wildcard", "SoundexWildcard"]]
ELSE RETURN[LIST["Prefix", "SoundexPrefix"]];
};
ENDCASE => RETURN[LIST["DWIM"]];
};

GetDefaultAttrType: PROC [attrvalue: ROPE] RETURNS [LIST OF ATOM] ~ {
IF Rope.Fetch[base: attrvalue, index: 0] IN ['0..'9] THEN RETURN[LIST[tOffice, tHome]];
RETURN[LIST[tName, tRname, tRemarks]];
};

Query: PROC [patterns: AttributePatterns, dbs: OpenDBs, searchAll: BOOLEAN _ FALSE, out: STREAM] RETURNS [--entry: Entry, cursor: Cursor--] ~ {
[] _ NextQuery[patterns, patterns, dbs, searchAll, out];
};

NextQuery: PROC [patterns: AttributePatterns, mypart: AttributePatterns, dbs: OpenDBs, searchAll: BOOLEAN _ FALSE, out: STREAM] RETURNS [stop: BOOLEAN _ FALSE] ~ {
orig: LoganQuery.AttributePatternRec;
attrTypes: LIST OF ATOM _ NIL;
pTypes: LIST OF ROPE _ NIL;
IF mypart=NIL THEN RETURN[ExecuteQuery[patterns, dbs, searchAll, out]];
orig _ mypart.first^;  -- save so can restore upon return
IF mypart.first.attr.type=NIL 
THEN attrTypes _ GetDefaultAttrType[mypart.first.attr.value]
ELSE attrTypes _ LIST[mypart.first.attr.type];
IF mypart.first.ptype=NIL 
THEN pTypes _ GetDefaultPType[mypart.first.attr]
ELSE pTypes _ LIST[mypart.first.ptype];
FOR pt: LIST OF ROPE _ pTypes, pt.rest WHILE pt#NIL DO
mypart.first.ptype _ pt.first;
FOR at: LIST OF ATOM _ attrTypes, at.rest WHILE at#NIL DO
mypart.first.attr.type _ at.first;
IF NextQuery[patterns, mypart.rest, dbs, searchAll, out] THEN GOTO Stop;
ENDLOOP;
ENDLOOP;
mypart.first^ _ orig;
EXITS
Stop => RETURN[stop: TRUE];
};

ExecuteQuery: PROC [patterns: AttributePatterns, dbs: OpenDBs, searchAll: BOOLEAN _ FALSE, out: STREAM] RETURNS [stop: BOOLEAN _ FALSE] ~ {
ENABLE LoganBerry.Error => {
IO.PutF[out, "Error: %g - %g\n", IO.atom[ec], IO.rope[explanation]];
GOTO Error;
};
PrintEntry: PROC [entry: Entry] = {
FOR e: LoganBerry.Entry _ entry, e.rest UNTIL e = NIL DO
IO.PutF[out, "%g: %g  ", IO.atom[e.first.type], IO.rope[e.first.value]];
ENDLOOP;
IO.PutRope[out, "\n"];
};
cursor: Cursor;
entry: Entry;
IF dbs=NIL THEN dbs _ GetDefaultDatabases[];
IO.PutRope[out, "\nTrying "];
LoganQuery.WriteAttributePatterns[s: out, ap: patterns];
FOR db: OpenDBs _ dbs, db.rest WHILE db#NIL DO
results: INT _ 0;
IO.PutF[out, "\nin %g\n", IO.rope[db.first.schema.dbName]];
cursor _ LoganQuery.QueryEntries[db.first.db, patterns].cursor;
DO
entry _ LoganQuery.NextEntry[cursor];
IF entry=NIL THEN EXIT;
results _ results + 1;
PrintEntry[entry];
ENDLOOP;
IO.PutF[out, "\n%g entries found.\n", IO.int[results]];
IF NOT searchAll AND results#0 THEN RETURN[stop: TRUE];
ENDLOOP;
EXITS
Error => RETURN[stop: TRUE];
};
tName: LoganBerry.AttributeType = $name;
tRname: LoganBerry.AttributeType = $rname;
tOffice: LoganBerry.AttributeType = $officenumber;
tHome: LoganBerry.AttributeType = $homenumber;
tRemarks: LoganBerry.AttributeType = $remarks;

GetName: PROC [entry: Entry] RETURNS [ROPE] ~ {
RETURN[GetAttributeValue[entry, tName]];
};
GetRName: PROC [entry: Entry] RETURNS [ROPE] ~ {
RETURN[GetAttributeValue[entry, tRname]];
};
GetHomePhone: PROC [entry: Entry] RETURNS [ROPE] ~ {
RETURN[GetAttributeValue[entry, tHome]];
};
GetOfficePhone: PROC [entry: Entry] RETURNS [ROPE] ~ {
RETURN[GetAttributeValue[entry, tOffice]];
};
GetRemarks: PROC [entry: Entry] RETURNS [ROPE] ~ {
RETURN[GetAttributeValue[entry, tRemarks]];
};

GetAttributeValue: PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] ~ {
FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN
RETURN[e.first.value];
ENDLOOP;
RETURN[NIL];
};
Open: PROC [dbname: ROPE] RETURNS [dbinfo: DBInfo] ~ {
ENABLE LoganBerry.Error => GOTO Error;
cp: FS.ComponentPositions;
fullDBName: ROPE;
dbinfo _ NEW[DBInfoRec];
[fullDBName, cp] _ FS.ExpandName[dbname];
IF cp.ext.length = 0 AND cp.ver.length = 0 THEN
fullDBName _ Rope.Concat[fullDBName, ".df"]; 
dbinfo.db _ LoganBerry.Open[dbName: fullDBName];
dbinfo.schema _ LoganBerry.Describe[db: dbinfo.db];
EXITS
Error => RETURN[NIL];
};
PhoneCmd: Commander.CommandProc = {
patterns: AttributePatterns;
dbs: OpenDBs;
searchAll, wantHome, placeCall: BOOLEAN;
[patterns, dbs, searchAll, wantHome, placeCall, msg] _ ParseQuery[cmd.commandLine];
IF msg#NIL THEN RETURN[NIL, msg];
IF patterns=NIL THEN RETURN[NIL, "No patterns given."];
Query[patterns, dbs, searchAll, cmd.out];
};

DirsCmd: Commander.CommandProc = {
IO.PutRope[cmd.out, "Whitepage databases: \n"];
FOR db: OpenDBs _ GetDefaultDatabases[], db.rest WHILE db#NIL DO
IO.PutF[cmd.out, "%g\n", IO.rope[db.first.schema.dbName]];
ENDLOOP;
};

Commander.Register[key: "WPPhone", proc: PhoneCmd, doc: "Place phone call by description"];
Commander.Register[key: "WPDirs", proc: DirsCmd, doc: "List whitepage directories"];

END. 
 WPCommands.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Doug Terry, July 16, 1987 2:23:04 pm PDT
Whitepage CommandTool commands, such as "Phone".

Ad-hoc query parsing
Command syntax:
Phone <attribute>(<filter>): <value> ... { at { home | office } } { in <dbname> } { ? } { one | some | all }
Defaults:
a missing <attribute> is taken to be:
"officenumber" if <value> starts with a digit and "at home" is not specified,
"homenumber" if <value> starts with a digit and "at home" is specified,
"rname" if <value> does not start with a digit but contains a ".",
"name" if <value> does not start with a digit and contains no ".".
a missing <filter> is taken to be:
"SimpleDWIM" (without subrange or date parsing).
a missing <dbname> is taken to be:
all standard databases.
Notes:
if "officenumber" is selected as a default and produces no results, then "homenumber" should be tried.

Defaults
Tries to read database names from stream, if empty then try user profile entries.
Whitepage query execution
The supplied patterns may be only partially specified (i.e. the attr.type or ptype may be given as NIL); in this case, a collection of default attr.types or ptypes are used where the default depends on properties of the attr.value.
The dbs may be NIL; in this case, a default list of databases is used.
A recursive backtracking algorithm to try queries for all possible combinations of attribute types and pattern types for all attributes (this is complicated).
Operations on entries
Miscellaneous
Opens the database with the given name; if the name is missing an explicit extension and version then ".df!H" is assumed.
Command registration
[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]
Execute query
[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]
Κ%˜š
œ™Icodešœ
Οm
œ1™<K™(—J˜Jš
œ0™0J™š
Οk	˜	Kšœžœ˜Kšœ
žœ˜(Kšœžœ"˜*Kšžœ
žœ
žœžœE˜eKšœžœf˜vKšœžœ|˜Œ
Kšœžœ$žœ˜>Kšœžœ˜Jš
œ
˜
—J˜šΠln
œžœ
ž˜JšžœD˜KKšœž˜K˜Kšžœžœžœ
˜Kšžœžœžœ
˜K˜Kšœžœ˜Kšœžœ˜(Kšœžœ˜5Kšœžœ"˜;Kšœžœ ˜7K˜Kšœ	žœžœ
žœ˜Jšœžœžœ˜šœžœžœ
˜Jšœ,Οc˜CJšœ žœ ˜8Jšœžœžœ ˜7Jšœ
žœžœ 3˜MJ˜——
head™™K™l—™	™%Kš
œM™MKš
œG™GKš
œB™BKš
œB™B—™"Kš
œ0™0—™"K™——™Kš
œf™fK™—šΟn
œžœžœžœ žœžœ
žœžœžœžœ
žœžœ
žœžœ˜Δ
•StartOfExpansion)[rope: 
ROPE, oldStream: 
STREAM _ NIL]š‘œžœ˜šžœ
žœž˜Kšžœ˜Kšžœ
˜—Kš
œ˜—Kšœžœžœ
žœ˜Kšœžœ
˜–-[stream: 
STREAM, breakProc: 
IO.BreakProc]šžœ ˜Kšœžœ/žœžœ˜Wšžœ
žœ
ž˜K–-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šœ%žœžœ
˜AK–-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šœ(žœžœ
˜DK–-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šœ'žœžœ
˜B–-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šœ&žœ˜1Kšœžœ/žœžœ˜WKšœ3žœ˜:Kš
œ˜—–-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šœ&žœ˜1Kšœ
žœ
˜Kšœžœ/žœžœ˜Wšžœ!žœžœ
ž˜2–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]šžœ7žœžœ˜IK˜
Kšžœ
˜K˜—Kšžœ
˜—šžœžœ
ž˜Kš
œ˜—šžœžœ
ž˜Kšœžœ
˜—Kš
œ˜—šžœ !˜/Kš	œžœžœžœ
žœ˜P– [base: 
ROPE, index: 
INT _ 0]šžœ6ž˜@šœ	 ˜'K–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]šœžœ!˜(Kšœžœ!˜(Kš
žœ
žœžœžœžœ ˜GK–[pName: 
ROPE]š
œI˜IK–9[base: 
ROPE, start: 
INT _ 0, len: 
INT _ 2147483647]š
œ>˜>Kšœžœ/žœžœ˜^K˜—Kšžœ˜ —Kšœžœ˜Kš
œ˜——Kšžœ
˜—K˜——™Kšœ )˜?K˜š‘œžœžœžœ˜KK™Qš‘œžœžœžœ˜5Kšœžœ
˜
Kšœžœžœ
žœ˜Kšœžœ
˜š
ž˜Kš	œ	žœžœ
žœžœ˜FKšœžœ˜Kšžœ
˜—K˜—Kšœžœ
˜
šžœžœ
ž˜Kš
œ#˜#—šžœžœ
ž˜Kš
œA˜A—Kš
œ˜K˜K˜—š‘œžœžœ˜7Kšžœžœ
žœžœ˜5Kšžœ
˜K˜K˜—š‘œžœžœžœ
žœ
žœ˜Mšžœž˜š
œ˜šžœ˜ Kšžœ
žœ
žœ
˜Kšžœ
žœ
žœ˜—Kš
œ˜—š
œ˜šžœ˜ Kšžœ
žœ
žœ ˜0Kšžœ
žœ
žœ˜-—Kš
œ˜—Kšžœžœ
žœ
˜ —K˜K˜—š‘œžœ
žœžœžœ
žœ
žœ˜EK– [base: 
ROPE, index: 
INT _ 0]š
žœ'žœ
žœ
žœ
žœ˜WKšžœ
žœ˜&K˜K˜——™š‘œžœ8žœžœžœžœ'˜
K™η
Kš
œF™FKš
œ8˜8K˜—K˜K™ž
š‘	œžœSžœžœžœžœžœžœ˜£
Kš
œ%˜%Kš	œžœ
žœ
žœžœ
˜Kš	œžœ
žœ
žœžœ
˜Kšžœžœ
žœ
žœ.˜GKšœ "˜9šžœžœ
˜Kšžœ8˜<Kšžœ
žœ˜.—šžœžœ
˜Kšžœ,˜0Kšžœ
žœ˜'—š
žœžœ
žœ
žœžœžœ
ž˜6Kš
œ˜š
žœžœ
žœ
žœžœžœ
ž˜9Kš
œ"˜"Kšžœ7žœ
žœ˜HKšžœ
˜—Kšžœ
˜—Kš
œ˜š
ž˜Kšœžœžœ˜—K˜K˜—š‘œžœ8žœžœžœžœžœžœ˜‹
šžœ˜Kšžœžœžœ˜DKšžœ˜K˜—–6 -- [entry: LoganBerry.Entry] RETURNS [continue: BOOL]š‘
œžœ˜#šžœ%žœžœ
ž˜8Kšžœžœžœ˜HKšžœ
˜—Kšžœ˜K˜—Kš
œ˜K˜
Kšžœžœ
žœ˜,K˜K–1[s: 
STREAM, ap: 
LoganQuery.AttributePatterns]š
œ8˜8šžœžœžœ
ž˜.Kšœ	žœ˜K–\[db: 
LoganBerry.OpenDB, patterns: 
LoganQuery.AttributePatterns, baseIndex: 
ATOM _ NIL]š
œ;˜;Kš
œ?˜?š
ž˜K–T[cursor: 
LoganQuery.ComplexCursor, dir: 
LoganBerry.CursorDirection _ increasing]š
œ%˜%Kšžœžœ
žœ
žœ
˜K˜K˜Kšžœ
˜—K–\[db: 
LoganBerry.OpenDB, patterns: 
LoganQuery.AttributePatterns, baseIndex: 
ATOM _ NIL]š
œ7˜7Kšžœ
žœžœžœ
žœžœ˜7Kšžœ
˜—š
ž˜Kšœ	žœžœ˜—K˜——™Kš
œ(˜(Kš
œ*˜*Kš
œ2˜2Kš
œ.˜.Kš
œ.˜.K˜š‘œžœžœžœ˜/Kšžœ"˜(K˜—š‘œžœžœžœ˜0Kšžœ#˜)K˜—š‘œžœžœžœ˜4Kšžœ"˜(K˜—š‘œžœžœžœ˜6Kšžœ$˜*K˜—š‘
œžœžœžœ˜2Kšžœ%˜+K˜K˜—š‘œžœ;žœ ˜yšžœ%žœžœ
ž˜8šžœž˜Kšžœ˜—Kšžœ
˜—Kšžœ
žœ˜K˜——™
š‘œžœ
žœžœ˜6Kš
œy™yJšžœžœ˜&Jšœžœ˜Jšœžœ
˜Kšœ	žœ˜Jšœžœ˜)šžœžœž˜/Jš
œ-˜-—Kš
œ0˜0K–8[conv: 
LoganBerry.Conv _ NIL, db: 
LoganBerry.OpenDB]š
œ3˜3š
ž˜Kšœ	žœ
žœ˜—K˜——™–L -- [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]š‘œ˜#Kš
œžœ
žœ
žœžœžœžœ
™HKš
œ˜Kš
œ
˜
Kšœ žœ
˜(Kš
œS˜SK™
Kš
žœžœ
žœ
žœ
žœ˜!Kš
žœ
žœ
žœ
žœ
žœ˜7Kš
œ)˜)K˜K˜—–L -- [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]š‘œ˜"Kš
œžœ
žœ
žœžœžœžœ
™HKšžœ-˜/šžœ.žœžœ
ž˜@Kšžœžœ˜:Kšžœ
˜—K˜—K˜K˜[K˜TK˜—Jšžœ˜—…—#;I