<> <> <> <> <<>> 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 ]; <> <> <(): ... { at { home | office } } { in } { ? } { one | some | all }>> <> < is taken to be:>> <<"officenumber" if starts with a digit and "at home" is not specified,>> <<"homenumber" if starts with a digit and "at home" is specified,>> <<"rname" if does not start with a digit but contains a ".",>> <<"name" if does not start with a digit and contains no ".".>> < is taken to be:>> <<"SimpleDWIM" (without subrange or date parsing).>> < is taken to be:>> <> <> <> <<>> 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 => { -- (): 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 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 = { <<[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]; <> 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.