VoiceDBImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Swinehart, May 19, 1986 9:21:00 am PDT
DIRECTORY
BasicTime USING [ Now ],
Convert USING [ IntFromRope ],
IO,
LoganBerry USING [ AttributeType, AttributeValue, DeleteEntry, Entry, Error, ErrorCode, Open, OpenDB, ReadEntry, WriteEntry ],
LoganBerryRpcControl USING [ ImportInterface, UnimportInterface ],
LupineRuntime USING [ BindingError ],
RefID USING [ nullID ],
Rope USING [ Concat, Equal, ROPE ],
RPC USING [ CallFailed, CallFailure, ImportFailed ],
Thrush USING [EncryptionKey, nullKey, Tune, VoiceInterval],
VoiceDB USING [ ErrorCode ],
VoiceUtils USING [ CurrentRName ]
;
VoiceDBImpl: CEDAR PROGRAM
IMPORTS BasicTime, Convert, IO, LoganBerry, LoganBerryRpcControl, LupineRuntime, Rope, RPC, VoiceUtils EXPORTS VoiceDB = {
OPEN IO;
Definitions
VoiceDBHandle: TYPE = REF VoiceDBHandleRec;
VoiceDBHandleRec: PUBLIC TYPE = RECORD [
Concrete implementation of VoiceDB.VoiceDBHandle
tunesDB: LoganBerry.OpenDB←RefID.nullID,
tuneRefDB: LoganBerry.OpenDB←RefID.nullID,
tunesDBName: Rope.ROPE,
tuneRefDBName: Rope.ROPE,
instance: Rope.ROPE,
imported: BOOL←FALSE
];
nullKey: Thrush.EncryptionKey ← Thrush.nullKey;
Interface procedures
Error: PUBLIC ERROR[ec: VoiceDB.ErrorCode, explanation: Rope.ROPE←NIL] = CODE;
Open: PUBLIC PROC[ dbName, instance, localName: Rope.ROPE ]
RETURNS [ handle: VoiceDBHandle←NIL, openEc: VoiceDB.ErrorCode←NIL, expl: Rope.ROPE ] = {
ENABLE {
RPC.CallFailed => []←PostRPCError[handle, why, TRUE];
{
openEc ← $communications;
expl ← IO.PutFR["No response from %g", rope[instance]];
GOTO ReturnAnyway;
};
Error => { openEc ← ec; expl ← explanation; GOTO ReturnAnyway; };
LoganBerry.Error => []←PostLBError[ec, explanation, TRUE, dbName];
VoiceDB errors raised in called routines propagate to client
};
handle ← NEW[VoiceDBHandleRec ← [
tunesDBName: dbName.Concat[".df"], tuneRefDBName: dbName.Concat["Refs.df"]]];
handle.instance ← instance;
 This version of VoiceDBImpl only knows how to open remote instances. We get into binder fun and games to do the local/remote thing. 
dbName ← handle.tunesDBName;
handle.tunesDB ← OpenLB[handle: handle, dbName: handle.tunesDBName];
dbName ← handle.tuneRefDBName;
handle.tuneRefDB ← OpenLB[handle: handle, dbName: handle.tuneRefDBName];
EXITS
ReturnAnyway => NULL; -- return incomplete handle.
};
Create: PUBLIC PROC[
handle: VoiceDBHandle,
tune: INT,
creator: Rope.ROPE,
interval: Thrush.VoiceInterval,
key: Thrush.EncryptionKey,
otherAttributes: LoganBerry.Entry
]
RETURNS [voiceFileID: Rope.ROPE←NIL, entry: LoganBerry.Entry←NIL] = TRUSTED {
reopening: BOOL←FALSE; {
ENABLE {
RPC.CallFailed => IF (reopening ← PostRPCError[handle, why, reopening]) THEN RETRY;
Error[$communications,
IO.PutFR["No response from %g", rope[handle.instance]]];
LoganBerry.Error =>
IF (reopening ← PostLBError[ec, explanation, reopening, handle.tunesDBName])
THEN RETRY;
};
cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE [LONG[@key]];
keyRope: Rope.ROPE = IO.PutFR["%bB %bB", IO.card[cardKey[0]], IO.card[cardKey[1]]];
voiceFileID ← IO.PutFR["%g %g", int[tune], time[BasicTime.Now[]]];
IF creator=NIL THEN creator ← VoiceUtils.CurrentRName[];
entry ← CONS[
[$vid, voiceFileID], CONS[
[$cre, creator], CONS[
[$sta, IO.PutFR["%g", int[interval.start]]], CONS[
[$num, IO.PutFR["%g", int[interval.length]]], CONS[
[$key, keyRope],
otherAttributes
]]]]];
IF reopening THEN handle.tunesDB ← OpenLB[handle:handle, dbName:handle.tunesDBName];
reopening ← FALSE;
LoganBerry.WriteEntry[ db: handle.tunesDB, entry: entry];
}; };
Retain: PUBLIC PROC[
handle: VoiceDBHandle,
voiceFileID: Rope.ROPE,
refID: Rope.ROPE,
refIDType: Rope.ROPE,
creator: Rope.ROPE,
otherAttributes: LoganBerry.Entry
]
RETURNS [entry: LoganBerry.Entry←NIL] = {
reopening: BOOL←FALSE; {
ENABLE {
RPC.CallFailed => IF (reopening ← PostRPCError[handle, why, reopening]) THEN RETRY;
RPC.CallFailed => Error[$communications,
IO.PutFR["No response from %g", rope[handle.instance]]];
LoganBerry.Error => IF (reopening ←
PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY;
VoiceDB errors raised in called routines also propagate to client
};
newTim, newVid: BOOL←FALSE;
IF creator=NIL THEN creator ← VoiceUtils.CurrentRName[];
IF reopening THEN handle.tuneRefDB ←
OpenLB[handle: handle, dbName: handle.tuneRefDBName];
reopening ← FALSE;
entry ← Query[handle, NIL, refID, refIDType].refEntry;
IF entry = NIL THEN
entry ← CONS[
[$rid, refID], CONS[
[$rtp, refIDType], CONS[
[$cre, creator],
otherAttributes
]]];
[entry, newTim] ← IncludeAttr[entry, $tim, IO.PutFR["%g", time[BasicTime.Now[]]], TRUE];
[entry, newVid] ← IncludeAttr[entry, $vid, voiceFileID, FALSE];
IF newTim OR newVid THEN Replace[handle.tuneRefDB, $rid, entry];
}; };
IncludeAttr: PROC[
entry: LoganBerry.Entry,
key: LoganBerry.AttributeType,
value: LoganBerry.AttributeValue,
replace: BOOL
TRUE means change value associated with (secondary) key, FALSE means add new value unless this value already exists.
] RETURNS [newEntry: LoganBerry.Entry, isNew: BOOL←TRUE] = {
FOR e: LoganBerry.Entry ← entry, e.rest WHILE e#NIL DO
IF key=e.first.type THEN {
IF replace THEN { e.first.value ← value; RETURN[entry, TRUE]; };
IF value#NIL AND value.Equal[e.first.value, FALSE] THEN RETURN[entry, FALSE];
};
ENDLOOP;
newEntry ← CONS[ [key, value], entry];
};
Forget: PUBLIC PROC[
handle: VoiceDBHandle,
refID: Rope.ROPE,
refIDType: Rope.ROPE
] = {
reopening: BOOL←FALSE; {
ENABLE {
RPC.CallFailed => IF (reopening ← PostRPCError[handle, why, reopening]) THEN RETRY;
RPC.CallFailed => Error[$communications,
IO.PutFR["No response from %g", rope[handle.instance]]];
LoganBerry.Error => IF (reopening ←
PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY;
VoiceDB errors raised in called routines also propagate to client
};
IF reopening THEN handle.tuneRefDB ← OpenLB[handle: handle, dbName: handle.tuneRefDBName];
reopening ← FALSE;
LoganBerry.DeleteEntry[db: handle.tuneRefDB, key: $rid, value: refID!
LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE];
}; };
Query: PUBLIC PROC [
handle: VoiceDBHandle,
voiceFileID: Rope.ROPE,
refID: Rope.ROPE,
refIDType: Rope.ROPE
] RETURNS [
tune: Thrush.Tune←-1,
interval: Thrush.VoiceInterval,
key: Thrush.EncryptionKey←Thrush.nullKey,
voiceEntry: LoganBerry.Entry←NIL,
refEntry: LoganBerry.Entry←NIL
] = TRUSTED {
reopening: BOOL←FALSE; {
ENABLE {
RPC.CallFailed => IF (reopening ← PostRPCError[handle, why, reopening]) THEN RETRY;
RPC.CallFailed => Error[$communications,
IO.PutFR["No response from %g", rope[handle.instance]]];
LoganBerry.Error => IF (reopening ←
PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY;
VoiceDB errors raised in called routines also propagate to client
};
cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE[LONG[@key]];
keyStream: IO.STREAM;
IF (refID#NIL AND refIDType=NIL) OR
((refID=NIL) = (voiceFileID=NIL)) THEN
Error[$clientError, "\nQuery specifies both refID and voiceFileID, or refIDType omitted."];
IF refID#NIL THEN {
IF reopening THEN handle.tuneRefDB ←OpenLB[handle: handle, dbName:handle.tuneRefDBName];
reopening ← FALSE;
refEntry ← LoganBerry.ReadEntry[db: handle.tuneRefDB, key: $rid, value: refID!
LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE].entry;
IF refEntry=NIL THEN RETURN;
IF ~GetAttr[refEntry, $rtp].Equal[refIDType] THEN
Error[$clientError, "\nWrong refIDType specified."];
voiceFileID ← GetAttr[refEntry, $vid];
};
{ -- Now refID scene is OK; separate LoganBerry error management for voiceFileID
ENABLE LoganBerry.Error => IF (reopening ←
PostLBError[ec, explanation, reopening, handle.tunesDBName]) THEN RETRY;
IF voiceFileID=NIL THEN RETURN;
IF reopening THEN handle.tunesDB←OpenLB[handle: handle, dbName: handle.tunesDBName];
reopening ← FALSE;
voiceEntry ← LoganBerry.ReadEntry[db: handle.tunesDB, key: $vid, value: voiceFileID!
LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE].entry;
IF voiceEntry=NIL THEN RETURN;
tune ← Convert.IntFromRope[voiceFileID];
interval ← [
Convert.IntFromRope[GetAttr[voiceEntry, $sta]],
Convert.IntFromRope[GetAttr[voiceEntry, $num]]];
keyStream ← IO.RIS[GetAttr[voiceEntry, $key]];
cardKey[0] ← IO.GetCard[keyStream];
cardKey[1] ← IO.GetCard[keyStream];
};
}; };
Replace: PROC[
db: LoganBerry.OpenDB, key: LoganBerry.AttributeType, entry: LoganBerry.Entry] = {
LoganBerry.WriteEntry[ db: db, entry: entry!
LoganBerry.Error => IF ec=$ValueNotUnique THEN GOTO DeleteFirst];
EXITS
DeleteFirst => {
LoganBerry.DeleteEntry[db: db, key: key, value: GetAttr[entry, key]];
LoganBerry.WriteEntry[ db: db, entry: entry];
};
};
GetAttr: PROC[entry: LoganBerry.Entry, key: LoganBerry.AttributeType]
RETURNS[value: LoganBerry.AttributeValue←NIL] = {
FOR ls: LoganBerry.Entry ← entry, ls.rest WHILE ls # NIL DO
IF ls.first.type = key THEN RETURN[ls.first.value];
ENDLOOP;
};
PostLBError: PROC[
ec: LoganBerry.ErrorCode,
explanation: Rope.ROPE,
reopening: BOOL,
dbName: Rope.ROPE
]
RETURNS[retry: BOOL←FALSE] = {
SELECT ec FROM
$CantOpenSchema, $CantOpenLog, $CantOpenIndex=>
Error[$dbNotFound, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]];
$BadSchema, $BadLogEntry, $BadIndex, $LogReadOnly => Error[$invalid,
IO.PutFR["%g: %g", rope[dbName], rope[explanation]]];
$DBNotAvailable => Error[$notAvailable,
IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]];
$DBClosed, $BadDBHandle =>
IF reopening THEN {
Error[$notAvailable,
IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]
}
ELSE RETURN[retry: TRUE];
$ValueNotUnique => Error[$voiceIDNotUnique,
IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]];
$NoIndex => Error[$refIDNotFound,
IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]];
$NoPrimaryKey => Error[$clientError,
IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]
ENDCASE; -- All others expected to propagate as uncaught signals
};
PostRPCError: PROC[
handle: VoiceDBHandle,
why: RPC.CallFailure,
reopening: BOOL
]
RETURNS[retry: BOOL] = {
SELECT why FROM
$timeout, $busy =>
Error[$communications, IO.PutFR["\nNo response from voice message database %g", rope[handle.instance]]];
$runtimeProtocol, $stubProtocol => Error[$invalid,
"\nProtocol violation in communications with voice message database"];
$unbound =>
IF ~reopening THEN { -- Force reopening of all databases
handle.tunesDB ← handle.tuneRefDB ← RefID.nullID;
handle.imported ← FALSE;
RETURN[TRUE];
}
ELSE Error[$invalid,
IO.PutFR["\nCan't bind to voice message database instance %g", rope[handle.instance]]];
ENDCASE=>ERROR;
};
OpenLB: PROC[handle: VoiceDBHandle, dbName: Rope.ROPE]
RETURNS [db: LoganBerry.OpenDB] = {
All errors managed higher-up
IF ~handle.imported THEN ImportLoganberry[handle];
db ← LoganBerry.Open[dbName: dbName];
};
ImportLoganberry: PROC[handle: VoiceDBHandle] = {
ENABLE {
RPC.ImportFailed => Error[$NotFound,
IO.PutFR["Could not import Loganberry from %g", rope[handle.instance]]];
};
TRUSTED {
LoganBerryRpcControl.UnimportInterface[!LupineRuntime.BindingError => CONTINUE];};
LoganBerryRpcControl.ImportInterface[["Loganberry.Lark", handle.instance]];
handle.tunesDB ← handle.tuneRefDB ← RefID.nullID;
handle.imported ← TRUE;
};
}.
Swinehart, May 19, 1986 9:20:57 am PDT
Cedar 6.1
changes to: DIRECTORY, VoiceDBImpl, Create, Retain