WPBTreeImpl.mesa
Copyright Ó 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Last Edited by: Swinehart, April 6, 1987 12:07:31 pm PDT
White pages databases can be browsed using the LoganBerryBrowser.
DIRECTORY
Atom USING [PropList],
Commander USING [GetProperty, Handle],
FS USING [ExpandName],
IO USING [atom, Put, PutF, rope],
LoganBerry USING [Close, EnumerateEntries, Error, Open, WriteEntry],
PrincOps USING [],
ProcessProps USING [GetPropList],
RefID USING [nullID],
Rope USING [Concat, ROPE],
ThNet USING [WPListing, WPState, WPStateBody],
UserProfile USING [Token],
VoiceUtils USING [Problem, WhereToReport]
;
WPBTreeImpl:
CEDAR
PROGRAM
IMPORTS Commander, FS, IO, LoganBerry, ProcessProps, Rope, UserProfile, VoiceUtils
EXPORTS ThNet = {
OPEN IO;
ROPE: TYPE = Rope.ROPE;
Representation primitives
Top-level State
WPListing: TYPE = ThNet.WPListing;
WPState: TYPE = ThNet.WPState;
ThNet Procedures
InitWhitePagesDatabase:
PUBLIC
PROC[
fileName: ROPE, howToComplain: VoiceUtils.WhereToReport←$System]
RETURNS[wpState: WPState←NIL] = {
IF fileName=
NIL
THEN
fileName ← UserProfile.Token[key: "ThrushWPFileName", default: "WhitePages.df"];
wpState ←
NEW[ThNet.WPStateBody ← [
dbName: FS.ExpandName[fileName].fullFName, howToComplain: howToComplain]];
[]←OpenWhitePagesDatabase[wpState];
};
OpenWhitePagesDatabase:
PROC[
wpState: WPState]
RETURNS [ok: BOOL←FALSE] = {
ENABLE LoganBerry.Error => {
VoiceUtils.Problem[IF ec=$DBNotAvailable THEN "Trouble opening white pages" ELSE "Trouble opening white pages", wpState.howToComplain]; CONTINUE }; --
IF wpState=NIL THEN RETURN[FALSE];
wpState.db ← LoganBerry.Open[dbName: wpState.dbName];
RETURN[TRUE];
};
CloseWhitePagesDatabase:
PUBLIC
PROC[
wpState: WPState, howToComplain: VoiceUtils.WhereToReport←$System]
RETURNS [ok: BOOL←TRUE] = {
IF wpState.db#RefID.nullID THEN LoganBerry.Close[db: wpState.db];
wpState.db ← RefID.nullID;
};
WhitePagesLookup:
PUBLIC
PROC[
wpState: WPState, name: ROPE, feep: BOOL←FALSE ]
RETURNS [ listing: WPListing←NIL ] = {
Returns first listing for which name is a substring, case unimportant, of the listing
FindOne:
PROC[entry: WPListing]
RETURNS [continue:
BOOLEAN←
FALSE] = {
IF feep AND listing#NIL THEN { listing ← NIL; RETURN; }; -- must be unique!
listing ← entry;
RETURN[feep];
};
IF ~OpenWhitePagesDatabase[wpState] THEN RETURN; -- Open is cheap!
[]←LoganBerry.EnumerateEntries[db: wpState.db, key:
IF feep
THEN $fnm
ELSE $rname,
start: name, end: name.Concat["\377"], proc: FindOne];
};
WhitePagesEntry:
PUBLIC
PROC[
wpState: WPState, name: ROPE←NIL, key: ATOM←$officenumber, feep: BOOL←FALSE,
listing: WPListing ← NIL]
RETURNS [fullRName: ROPE←NIL, entry: ROPE←NIL, newListing: WPListing←NIL] = {
IF listing = NIL THEN listing ← WhitePagesLookup[wpState, name, feep];
newListing ← listing;
IF newListing = NIL THEN RETURN;
fullRName ← Fetch[newListing, $rname];
IF key#NIL THEN entry ← Fetch[newListing, key];
};
WhitePagesEnter:
PUBLIC
PROC[wpState: WPState, listing: WPListing] = {
IF ~OpenWhitePagesDatabase[wpState] THEN RETURN;
LoganBerry.WriteEntry[db: wpState.db, entry: listing, replace: TRUE];
};
WhitePagesPrint:
PUBLIC
PROC[wpState: WPState, listing: WPListing] = {
p: Atom.PropList = ProcessProps.GetPropList[];
h: Commander.Handle;
IF p=NIL THEN RETURN;
h ← NARROW[Commander.GetProperty[$CommanderHandle, p]];
FOR lst: WPListing ← listing, lst.rest
WHILE lst#
NIL
DO
h.out.PutF["%g: %g\n", atom[lst.first.type], rope[lst.first.value]];
IF lst.first.type=$Rname AND h.out#h.err THEN h.err.Put[rope[lst.first.value], rope["\n"]];
ENDLOOP;
};
Fetch:
PROC[listing: WPListing, key:
ATOM]
RETURNS [value:
ROPE←
NIL] = {
FOR lst: WPListing ← listing, lst.rest
WHILE lst#
NIL
DO
IF lst.first.type = key THEN RETURN[lst.first.value];
ENDLOOP;
};
}.
Swinehart, May 16, 1985 9:16:38 am PDT
Cedar 6.0
changes to: DIRECTORY, WPBTreeImpl, WhitePagesFill
Swinehart, October 28, 1985 12:05:20 pm PST
Log => VoiceUtils
changes to: DIRECTORY, WPBTreeImpl, InitWhitePagesDatabase, OpenWhitePagesDatabase, CloseWhitePagesDatabase, GetLinkValues, WhitePagesFill
Swinehart, November 7, 1986 5:20:40 pm PST
Use LoganBerry instead of specialized BTree stuff.
changes to: WPBTreeImpl, WPState, InitWhitePagesDatabase, OpenWhitePagesDatabase, WhitePagesLookup, FindOne, WhitePagesEntry, Fetch, WhitePagesEnter, WhitePagesPrint, WPFn, WhitePagesDo, }, DIRECTORY