DIRECTORY
Atom,
Basics,
IO,
PhoneMappings USING [ PhoneMap ],
Rope USING [Cat, Fetch, Flatten, FromChar, Length, MakeRope, ROPE],
ThNet
;
WhitePagesImpl:
CEDAR
PROGRAM
IMPORTS Atom, IO, Rope
EXPORTS ThNet = {
ROPE:TYPE=Rope.ROPE;
intelnetPause: ROPE ← "\017P";
CR: CHAR = '\n;
Blank: CHAR = ' ; -- space
endChar: CHAR='\000;
HowToDial:
PUBLIC
PROC[phoneNumber:
ROPE, ownExtension:
ROPE]
RETURNS [whatToDial: ROPE, isLocalExtension: BOOLEAN] = {
map: PhoneMappings.PhoneMap ← NARROW[Atom.GetProp[$PhoneMap, $map]];
phoneNumber ← MapNumber[phoneNumber, map, intelnetPause, ownExtension];
RETURN[phoneNumber, phoneNumber.Length[]<6];
};
MapNumber:
PROC [from:
ROPE, map: PhoneMappings.PhoneMap, a1:
ROPE←
NIL, a2:
ROPE←
NIL]
RETURNS [to: ROPE] = {
Maps phone number patterns according to local conventions, as represented in the "map" list. This string is a list of lines, each line representing a pattern match and substitution. MapNumber goes through the sequence once. For each line, the left hand side is matched with the current phone number. If it matches, the right hand side is substituted for the current phone number (wild cards are replaced by the input characters they matched). An example of a line is "408nnnnnnn = 9,408nnnnnnn". It says, "to dial something in the 408 area code, dial 9 for an outside line, pause a second, then dial 408 and the local number."
Put the unlikely pair ["zzzzzzzzzzzzzzzzzzz", "z"] at the end of the map list to be sure that the result has had punctuation stripped from it. (Otherwise an input that has not been converted for other reasons will still have punctuation in it!) Don't put any 'z characters anywhere else.
mapStream: IO.STREAM ← NIL;
fromStream: IO.STREAM ← NIL;
toStream: IO.STREAM ← NIL;
repStream: IO.STREAM ← NIL;
mc: CHAR ← 'n;
changed: BOOL←FALSE;
to ← from;
FOR nextMap: PhoneMappings.PhoneMap ← map, nextMap.rest
WHILE nextMap #
NIL
DO
mapStream ← IO.RIS[nextMap.first.pattern, mapStream];
repStream ← IO.RIS[nextMap.first.replacement, repStream];
fromStream ← IO.RIS[to, fromStream];
toStream ← IO.ROS[toStream]; toStream.Reset[];
WHILE
TRUE
DO
fc: CHAR;
mc ← IF mapStream.EndOf[] THEN endChar ELSE mapStream.GetChar[];
IF mc=Blank THEN LOOP;
fc ← NextNonBlank[fromStream];
SELECT mc
FROM
Blank, CR => LOOP;
'n, 'x, 'y =>
IF fc#endChar
THEN
{ IF CopyLiterals[toStream, repStream, mc, a1, a2] THEN toStream.PutChar[fc]} ELSE EXIT;
'z =>
IF changed
THEN
EXIT
ELSE IF fc=endChar THEN GOTO matched ELSE toStream.PutChar[fc]; -- Plain copy!
endChar => IF fc#endChar THEN EXIT ELSE GOTO matched;
ENDCASE => IF fc#mc THEN EXIT;
REPEAT
matched => {
IF mc#'z AND CopyLiterals[toStream, repStream, 'n, a1, a2] THEN ERROR; -- replacement out of synch
to ← IO.RopeFromROS[toStream];
changed ← TRUE;
};
ENDLOOP;
ENDLOOP;
mapStream.Close[]; fromStream.Close[]; toStream.Close[]; repStream.Close[];
};
NextNonBlank:
PROC[s:
IO.
STREAM]
RETURNS [c:
CHAR] = {
WHILE ~s.EndOf[]
DO
SELECT (c←s.GetChar[])
FROM
IN ['0..'9] => RETURN;
ENDCASE;
ENDLOOP;
RETURN[endChar];
};
CopyLiterals:
PROC[to, from:
IO.
STREAM, patternChar:
CHAR, arg1:
ROPE, arg2:
ROPE]
RETURNS[needAChar: BOOL] = {
c: CHAR;
WHILE ~from.EndOf[]
DO
SELECT (c𡤏rom.GetChar[])
FROM
'n, 'x, 'y => {
IF c=patternChar THEN RETURN[TRUE];
from.Backup[c];
RETURN[FALSE];
};
'A => to.PutRope[arg1];
'B => to.PutRope[arg2];
ENDCASE => to.PutChar[c];
ENDLOOP;
RETURN[FALSE];
};
FeepName:
PUBLIC
PROC[rName:
ROPE]
RETURNS[feepName:
ROPE] = {
qdCheck: CARDINAL𡤀
FeepFetch:
PROC[data:
REF, index:
INT]
RETURNS [c:
CHAR] = {
c←NARROW[data, ROPE].Fetch[index];
IF c IN ['A..'Z] THEN c𡤌+('a-'A);
qdCheck ← qdCheck+LOOPHOLE[c, [0..256)];
IF c NOT IN ['a..'z] THEN c←'z+1;
RETURN[FeepMap[c]];
};
feepName ← Rope.MakeRope[base: rName, size: rName.Length[], fetch: FeepFetch];
feepName ← Rope.Flatten[feepName];
feepName ← Rope.Cat[feepName,
Rope.FromChar[LOOPHOLE[LOOPHOLE[qdCheck, Basics.BytePair].high, CHAR]],
Rope.FromChar[LOOPHOLE[LOOPHOLE[qdCheck, Basics.BytePair].low, CHAR]]
];
};
FeepMap:
PACKED
ARRAY
CHAR['a..'z+1]
OF
CHAR = [
'2, '2, '2, '3, '3, '3, '4, '4, '4, '5, '5, '5, '6, '6, '6, '7, '7, '7, '7, '8, '8, '8, '9, '9, '9, '9, '1 ];