WPCommands.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Terry, July 16, 1987 2:23:04 pm PDT
Whitepage CommandTool commands, such as "Phone".
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
];
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.
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;
};
Defaults
WhitePages: OpenDBs; -- the set of default whitepage databases
SetDefaultDatabases:
PROC [directoryFiles
: ROPE]
RETURNS [dbs: OpenDBs] ~ {
Tries to read database names from stream, if empty then try user profile entries.
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]];
};
Whitepage query execution
Query:
PROC [patterns: AttributePatterns, dbs: OpenDBs, searchAll:
BOOLEAN ←
FALSE, out:
STREAM]
RETURNS [--entry: Entry, cursor: Cursor--] ~ {
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.
[] ← NextQuery[patterns, patterns, dbs, searchAll, out];
};
A recursive backtracking algorithm to try queries for all possible combinations of attribute types and pattern types for all attributes (this is complicated).
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];
};
Operations on entries
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];
};
Miscellaneous
Open:
PROC [dbname:
ROPE]
RETURNS [dbinfo: DBInfo] ~ {
Opens the database with the given name; if the name is missing an explicit extension and version then ".df!H" is assumed.
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];
};
Command registration
PhoneCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
patterns: AttributePatterns;
dbs: OpenDBs;
searchAll, wantHome, placeCall: BOOLEAN;
[patterns, dbs, searchAll, wantHome, placeCall, msg] ← ParseQuery[cmd.commandLine];
Execute query
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 = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
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.