LoganBerryClassImpl.mesa
Copyright Ó 1989, 1992 by Xerox Corporation. All rights reserved.
Doug Terry, October 24, 1990 5:43 pm PDT
Christian Jacobi, April 23, 1992 10:44 am PDT
Mechanisms for registering new LoganBerry classes. A LoganBerry class is a collection of routines that implement the LoganBerry interface. In addition to the standard LoganBerry implementation, examples of LoganBerry classes include stubs for performing RPC calls to remote LoganBerry servers and "veneers" that enable other databases, such as Cypress, to be accessed as LoganBerry databases.
This module maps calls on the generic LoganBerry interface into calls on a specific LoganBerry class. A specific class is bound to a database handle during the Open call. On Open, each registered LoganBerry class is given the opportunity to Open the named database. The first class that returns a non-null open database handle is used for subsequent calls on that handle. Thus, the Open routine for each class should first check that the named database is one that is managed by the particular class.
On Open, an effort is made to return the same handle for the same database since write procs are associated with a given database handle. Unfortunately, only the class-specific Open routine can determine that two names, such as "SampleLB.df" and "/Strowger//Temp/SampleLB.df", refer to the same database. The algorithm for Open is as follows:
1. Lookup the presented name in the openDBTable; if found then return the associated generic OpenDB handle. This is simply an optimization to avoid calling the class-specific Open routines.
2. Call each class-specific Open routine until one returns a non-null class-specific OpenDB handle.
3. Look in the openDBTable to see if any generic OpenDB handles are associated with the class-specific OpenDB handle returned in step 2. If so, then return the previously returned generic OpenDB handle. In this case, although the presented name differs from the name of any database that has been previously opened, we conclude that the database is really the same.
4. Add an entry to the openDBTable associating the presented database name with the returned generic OpenDB handle. Note that several entries in the openDBTable may have different names but the same generic OpenDB handle.
Thus, if a LoganBerry class is careful to always return the same handle for the same database (regardless of what name gets passed to it), then the generic level preserves this property.
Willie-s, April 23, 1992 5:13 pm PDT
DIRECTORY
IO USING [atom, PutFR1],
RefID USING [Release, Reseal, Seal, Unseal],
SymTab USING [Create, EachPairAction, Fetch, Insert, Pairs, Ref],
LoganBerry,
LoganBerryClass;
LoganBerryClassImpl: CEDAR MONITOR -- for Write proc registration stuff
IMPORTS IO, RefID, SymTab
EXPORTS LoganBerry, LoganBerryClass
~ BEGIN
OPEN LoganBerry, LoganBerryClass;
registeredClasses: LIST OF Class ¬ NIL; -- list of registered classes
openDBTable: SymTab.Ref ¬ NIL;   -- table of open database handles
GenericOpenDBInfo: TYPE = REF GenericOpenDBRecord;
GenericOpenDBRecord: TYPE = RECORD [
class: Class ¬ NIL,   -- class associated with generic db handle
db: OpenDB,    -- class-specific db handle
registeredWriteProcs: LIST OF WriteProcRegistration
];
GenericCursorInfo: TYPE = REF GenericCursorRecord;
GenericCursorRecord: TYPE = RECORD[
class: Class,    -- class associated with generic cursor
cursor: Cursor    -- class-specific cursor handle
];
WriteProcRegistration: TYPE = REF WriteProcRegistrationBody;
WriteProcRegistrationBody: TYPE = RECORD[
proc: LoganBerry.WriteProc,
ident: ATOM,
clientData: REF
];
Error: PUBLIC ERROR [ec: ErrorCode, explanation: ROPE ¬ NIL] = CODE;
Opening databases
Open: PUBLIC PROC [conv: Conv ¬ NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ {
dbinfo: GenericOpenDBInfo;
IF openDBTable = NIL THEN
openDBTable ¬ SymTab.Create[mod: 2039, case: FALSE];
dbinfo ¬ NARROW[SymTab.Fetch[openDBTable, dbName].val];
IF dbinfo = NIL
THEN { -- database not previously opened (under this name)
dbinfo ¬ NEW[GenericOpenDBRecord];
dbinfo.registeredWriteProcs ¬ NIL;
Try registered Open procedures until one returns a non-null handle.
FOR c: LIST OF Class ¬ registeredClasses, c.rest WHILE c#NIL DO
IF c.first.open # NIL THEN
dbinfo.db ¬ c.first.open[conv, dbName];
IF dbinfo.db # LoganBerry.nullDB THEN {
dbinfo.class ¬ c.first;
EXIT;
};
ENDLOOP;
IF dbinfo.class = NIL THEN
ERROR Error[$CantOpenSchema, "No registered class manages the named database."];
Add entry to openDBTable table, first making sure that the database name is not an alias for a database previously opened.
dbinfo ¬ CheckAndSaveOpenDB[dbName, dbinfo];
db ¬ RefID.Seal[dbinfo];
}
ELSE { -- reopen database
IF dbinfo.class.open # NIL THEN
dbinfo.db ¬ dbinfo.class.open[conv, dbName];
db ¬ RefID.Reseal[dbinfo];
};
};
CheckAndSaveOpenDB: ENTRY PROC [dbName: ROPE, dbinfo: GenericOpenDBInfo] RETURNS [GenericOpenDBInfo] ~ {
This routine is monitored since two or more clients may be trying to open the same database at the same time. A check is made to see if an entry already in the openDBTable refers to the same class-specific OpenDB handle. If so, then the existing dbinfo record is returned. In either case, an new entry is added to the openDBTable.
CheckDB: SymTab.EachPairAction = {
[key: ROPE, val: SymTab.Val] RETURNS [quit: BOOL ← FALSE]
prevdbinfo: GenericOpenDBInfo ¬ NARROW[val];
IF prevdbinfo.class = dbinfo.class AND prevdbinfo.db = dbinfo.db THEN {
dbinfo ¬ prevdbinfo;
quit ¬ TRUE;
};
};
[] ¬ SymTab.Pairs[x: openDBTable, action: CheckDB];
[] ¬ SymTab.Insert[x: openDBTable, key: dbName, val: dbinfo];
RETURN[dbinfo];
};
Methods
ReadEntry: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.readEntry = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
[entry, others] ¬ dbinfo.class.readEntry[conv, dbinfo.db, key, value];
};
EnumerateEntries: PUBLIC PROC [db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL, proc: EntryProc] RETURNS [] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.enumerateEntries = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.enumerateEntries[dbinfo.db, key, start, end, proc];
};
GenerateEntries: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL] RETURNS [cursor: Cursor] ~ {
cinfo: GenericCursorInfo ¬ NEW[GenericCursorRecord];
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.generateEntries = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
cinfo.class ¬ dbinfo.class;
cinfo.cursor ¬ dbinfo.class.generateEntries[conv, dbinfo.db, key, start, end];
cursor ¬ RefID.Seal[cinfo];
};
NextEntry: PUBLIC PROC [conv: Conv ¬ NIL, cursor: Cursor, dir: CursorDirection ¬ increasing] RETURNS [entry: Entry] ~ {
cinfo: GenericCursorInfo ¬ GetCursorInfo[cursor];
IF cinfo.class.nextEntry = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[cinfo.class.name]]];
entry ¬ cinfo.class.nextEntry[conv, cinfo.cursor, dir];
};
EndGenerate: PUBLIC PROC [conv: Conv ¬ NIL, cursor: Cursor] RETURNS [] ~ {
cinfo: GenericCursorInfo ¬ GetCursorInfo[cursor];
IF cinfo.class.endGenerate = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[cinfo.class.name]]];
cinfo.class.endGenerate[conv, cinfo.cursor];
[] ¬ RefID.Release[cursor];
};
WriteEntry: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB, entry: Entry, log: LogID ¬ activityLog, replace: BOOLEAN ¬ FALSE] RETURNS [] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.writeEntry = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.writeEntry[conv, dbinfo.db, entry, log, replace];
ReportWrites[dbinfo, entry]; -- to registered procedures.
};
DeleteEntry: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [] ~ {
entry: Entry;
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.deleteEntry = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
entry ¬ dbinfo.class.deleteEntry[conv, dbinfo.db, key, value];
IF entry#NIL THEN ReportWrites[dbinfo, entry]; -- to registered procedures.
};
Close: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.close = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.close[conv, dbinfo.db];
};
BuildIndices: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.buildIndices = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.buildIndices[conv, dbinfo.db];
};
CompactLogs: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.compactLogs = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.compactLogs[conv, dbinfo.db];
};
Describe: PUBLIC PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [info: SchemaInfo] ~ {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.describe = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
info ¬ dbinfo.class.describe[conv, dbinfo.db];
};
IsLocal: PUBLIC PROC [db: LoganBerry.OpenDB] RETURNS[local: BOOL ¬ TRUE] = {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.isLocal = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
local ¬ dbinfo.class.isLocal[dbinfo.db];
};
StartTransaction: PUBLIC PROC [db: LoganBerry.OpenDB, wantAtomic: BOOLEAN ¬ FALSE] = {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.startTransaction = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
dbinfo.class.startTransaction[dbinfo.db, wantAtomic];
};
EndTransaction: PUBLIC PROC [db: LoganBerry.OpenDB, commit: BOOLEAN ¬ TRUE] RETURNS [committed: BOOLEAN] = {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.endTransaction = NIL THEN ERROR Error[$NotImplemented, IO.PutFR1["procedure not available for class %g.", IO.atom[dbinfo.class.name]]];
committed ¬ dbinfo.class.endTransaction[dbinfo.db, commit];
};
FlushDBCache: PUBLIC PROC [db: LoganBerry.OpenDB ¬ LoganBerry.nullDB] = {
IF db # LoganBerry.nullDB
THEN { -- flush specific database
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
IF dbinfo.class.flushDBCache # NIL THEN
dbinfo.class.flushDBCache[dbinfo.db];
}
ELSE { -- flush all databases in all classes
FOR c: LIST OF Class ¬ registeredClasses, c.rest WHILE c # NIL DO
IF c.first.flushDBCache # NIL THEN
c.first.flushDBCache[LoganBerry.nullDB];
ENDLOOP;
};
};
GetDBSpecifics: PUBLIC PROC [db: LoganBerry.OpenDB] RETURNS [class: ATOM, dbhandle: LoganBerry.OpenDB] = {
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
class ¬ dbinfo.class.name;
dbhandle ¬ dbinfo.db;
};
GetInfo: PROC [db: OpenDB] RETURNS [GenericOpenDBInfo] ~ INLINE {
Unseals the database handle and ensures that it's valid.
ref: REF = RefID.Unseal[db];
IF ref = NIL THEN
ERROR Error[$BadDBHandle, "NIL OpenDB handle."];
WITH ref SELECT FROM
dbinfo: GenericOpenDBInfo => {
RETURN[dbinfo];
};
ENDCASE => ERROR Error[$BadDBHandle, "Invalid OpenDB handle."];
};
GetCursorInfo: PROC [cursor: Cursor] RETURNS [GenericCursorInfo] ~ INLINE {
Unseals the cursor and ensures that it's valid.
ref: REF = RefID.Unseal[cursor];
IF ref = NIL THEN
ERROR Error[$BadCursor, "NIL cursor."];
WITH ref SELECT FROM
cinfo: GenericCursorInfo => {
RETURN[cinfo];
};
ENDCASE => ERROR Error[$BadCursor, "Invalid cursor."];
};
Write procedure registration
Code written by Dan Swinehart.
Note: for remote databases this doesn't provide the same guarantees as for local database. That is, the registered procedures only see updates that are invoked at the same site on the same database handle. Updates to the database performed by other clients at other sites are not observed.
RegisterWriteProc: PUBLIC ENTRY PROC [proc: LoganBerry.WriteProc, db: LoganBerry.OpenDB, ident: ATOM, clientData: REF] = {
ENABLE UNWIND => NULL;
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
reg: WriteProcRegistration ¬ NEW[ WriteProcRegistrationBody ¬ [proc: proc, ident: ident, clientData: clientData]];
FOR r: LIST OF WriteProcRegistration ¬ dbinfo.registeredWriteProcs, r.rest WHILE r#NIL DO
IF r.first.ident=ident THEN { r.first ¬ reg; RETURN; };
ENDLOOP;
dbinfo.registeredWriteProcs ¬ CONS[reg, dbinfo.registeredWriteProcs];
};
UnregisterWriteProc: PUBLIC ENTRY PROC [db: LoganBerry.OpenDB, ident: ATOM] = {
ENABLE UNWIND => NULL;
dbinfo: GenericOpenDBInfo ¬ GetInfo[db];
regs: LIST OF WriteProcRegistration ¬ dbinfo.registeredWriteProcs;
IF regs=NIL THEN RETURN;
IF ident=regs.first.ident THEN { dbinfo.registeredWriteProcs ¬ regs.rest; RETURN; };
FOR r: LIST OF WriteProcRegistration¬regs, r.rest WHILE r.rest#NIL DO
IF r.rest.first.ident=ident THEN { r.rest ¬ r.rest.rest; RETURN; };
ENDLOOP;
};
ReportWrites: --ENTRY-- PROC [dbinfo: GenericOpenDBInfo, entry: Entry] = {
Warning: This routine is unmonitored so the list of registered procs may be changing as it is being traversed. This should be okay.
FOR r: LIST OF WriteProcRegistration ¬ dbinfo.registeredWriteProcs, r.rest WHILE r#NIL DO
r.first.proc[RefID.Reseal[dbinfo], entry, r.first.ident, r.first.clientData];
ENDLOOP;
};
Registration
Register: PUBLIC PROC [name: ATOM, class: Class, tryLast: BOOLEAN ¬ FALSE] RETURNS [] ~ {
Registers the given LoganBerry class with the given name. Any class already registered with the name is replaced. class=NIL unregisters the named class. If tryLast=TRUE then this class is given the last opportunity to open a named database (this is intended for use by the main LoganBerry implementation); otherwise, newly registered classes are placed at the front of the line.
found: BOOLEAN ¬ FALSE;
prev: LIST OF Class ¬ NIL;
FOR c: LIST OF Class ¬ registeredClasses, c.rest WHILE c # NIL DO
IF c.first.name = name THEN { -- found named class
found ¬ TRUE;
EXIT;
};
prev ¬ c;
ENDLOOP;
SELECT TRUE FROM
NOT found AND class # NIL =>  -- add named class
IF tryLast AND registeredClasses # NIL
THEN prev.rest ¬ LIST[class]
ELSE registeredClasses ¬ CONS[class, registeredClasses];
found AND class # NIL =>  -- replace named class
IF prev = NIL
THEN registeredClasses.first ¬ class
ELSE prev.rest.first ¬ class;
found AND class = NIL =>  -- remove named class
IF prev = NIL
THEN registeredClasses ¬ registeredClasses.rest
ELSE prev.rest ¬ prev.rest.rest;
ENDCASE;
};
Lookup: PUBLIC PROC [name: ATOM] RETURNS [class: Class] ~ {
Returns the named class or NIL if a class is not registered under the given name.
class ¬ NIL;
FOR c: LIST OF Class ¬ registeredClasses, c.rest WHILE c # NIL DO
IF c.first.name = name THEN { -- found named class
class ¬ c.first;
EXIT;
};
ENDLOOP;
};
List: PUBLIC PROC [] RETURNS [classes: LIST OF Class] ~ {
Returns a list of all currently registered classes.
classes ¬ registeredClasses;
};
END.