RemindImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
David Goldberg November 13, 1989 7:59:49 pm PST
Peter B. Kessler, January 17, 1990 9:11:14 pm PST
Last changed by Pavel on February 12, 1990 5:40:45 pm PST
Kenneth A. Pier, April 19, 1990 10:56 am PDT
Theimer, September 17, 1990 11:22 pm PDT
Last tweaked by Mike Spreitzer August 27, 1993 8:19 am PDT
Willie-s, May 6, 1992 1:11 pm PDT
DIRECTORY
Arpa USING [Address],
Basics,
BasicTime,
Commander, CommanderOps,
Convert,
FS USING [StreamOpen],
IntHashTable,
IO,
List USING [LORA, Remove],
LoganBerry USING [Attribute, BuildIndices, Close, CompactLogs, Cursor, DeleteEntry, EndGenerate, Entry, Error, GenerateEntries, NextEntry, nullDB, Open, OpenDB, ReadEntry, RegisterWriteProc, UnregisterWriteProc, WriteEntry],
NetworkName,
RedBlackTree,
Remind,
Rope,
rtable3,
SimpleFeedback,
SunPMap,
SunPMapClient,
SunRPC,
SunRPCAuth,
SunRPCOnUDP,
SymTab,
SystemNames USING [UserCedarDir, UserName],
TimeParse USING [Adjust],
UnixSysCalls USING [GetPID],
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Token],
UXTime;
RemindImpl: CEDAR PROGRAM
IMPORTS Basics, BasicTime, Commander, CommanderOps, Convert, FS, IntHashTable, IO, List, LoganBerry, NetworkName, RedBlackTree, Rope, rtable3, SimpleFeedback, SunPMapClient, SunRPC, SunRPCAuth, SunRPCOnUDP, SymTab, SystemNames, TimeParse, UnixSysCalls, UserProfile, UXTime
EXPORTS Remind
Implements the remind interface, and also contains the PostReminders proc, which runs in the background and pops up reminders
= BEGIN OPEN Remind, RT:rtable3;
ROPE: TYPE ~ Rope.ROPE;
RTable: TYPE ~ RT.TABLEPROG3;
repetitionNames: ARRAY Repetitions OF ROPE = [
"once", "daily", "weekdays", "weekly", "biweekly", "monthly", "yearly", "nthWeekday", "everyNthDay", "everyNthWeek", "everyNthMonth", "other"];
RopeFromRepetition: PUBLIC PROC[rep: Repetitions] RETURNS [ROPE] = {
RETURN[repetitionNames[rep]];
};
RepetitionFromRope: PUBLIC PROC[str: ROPE] RETURNS [Repetitions] = {
FOR rep: Repetitions IN Repetitions DO
IF Rope.Equal[str, repetitionNames[rep], FALSE] THEN RETURN[rep];
ENDLOOP;
RETURN[once];
};
meetingTypeNames: ARRAY MeetingType OF ROPE = [ "none", "meeting", "command", "seminar", "protectedCmd"];
RopeFromMeetingType: PUBLIC PROC[type: MeetingType] RETURNS [ROPE] = {
RETURN[meetingTypeNames[type]];
};
MeetingTypeFromRope: PUBLIC PROC[str: ROPE] RETURNS [MeetingType] = {
FOR type: MeetingType IN MeetingType DO
IF Rope.Equal[str, meetingTypeNames[type], FALSE] THEN RETURN[type];
ENDLOOP;
RETURN[meeting];
};
BadData: PUBLIC ERROR = CODE;
RepsToPeriod: ARRAY Repetitions OF RT.Interval ~ [once: single, daily: daily, weekdays: daily, weekly: weekly, biweekly: biweekly, monthly: monthly, yearly: yearly, nthWeekday: nthWeekday, everyNthDay: everyNthDay, everyNthWeek: everyNthWeek, everyNthMonth: everyNthMonth, other: otherPeriod];
PeriodToReps: ARRAY RT.Interval OF Repetitions ~ [single: once, daily: daily, weekly: weekly, biweekly: biweekly, monthly: monthly, yearly: yearly, nthWeekday: nthWeekday, everyNthDay: everyNthDay, everyNthWeek: everyNthWeek, everyNthMonth: everyNthMonth, otherPeriod: other];
- Next 3 routines are candidates for INLINE
IntFromTime: PROC[time: BasicTime.GMT] RETURNS [INT] = {
RETURN [BasicTime.Period[BasicTime.earliestGMT, time]];
};
TimeFromInt: PROC[int: INT] RETURNS [BasicTime.GMT] = {
RETURN[BasicTime.Update[BasicTime.earliestGMT, int]];
};
MyRopeFromInt: PROC[int: INT] RETURNS [ROPE] = {
RETURN[IO.PutFR1["%010g", IO.int[int]]];
};
TimeFromUnixCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
i: INT;
t: BasicTime.GMT;
IF argv.argc # 2 THEN RETURN [$Failure, Rope.Cat["Usage: ", argv[0], " <an integer>"]];
i ¬ Convert.IntFromRope[argv[1]];
t ¬ UnixToBasicTime[i];
cmd.out.PutF["%g ~ %g\n", [integer[i]], [rope[Convert.RopeFromTime[from: t, end: seconds]]] ];
RETURN};
TimeFromIntCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
i: INT;
t: BasicTime.GMT;
IF argv.argc # 2 THEN RETURN [$Failure, Rope.Cat["Usage: ", argv[0], " <an integer>"]];
i ¬ Convert.IntFromRope[argv[1]];
t ¬ TimeFromInt[i];
cmd.out.PutF["%g ~ %g\n", [integer[i]], [rope[Convert.RopeFromTime[from: t, end: seconds]]] ];
RETURN};
GMTUpCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
i: INT;
t: BasicTime.GMT;
IF argv.argc # 2 THEN RETURN [$Failure, Rope.Cat["Usage: ", argv[0], " <an integer>"]];
i ¬ Convert.IntFromRope[argv[1]];
t ¬ LOOPHOLE[i];
cmd.out.PutF["%g ~ %g\n", [integer[i]], [rope[Convert.RopeFromTime[from: t, end: seconds]]] ];
RETURN};
baseGMT: BasicTime.GMT ¬ UXTime.ToGMT[UXTime.earliestUXTIME];
limitUnixTime: INT ¬ BasicToUnixTime[BasicTime.latestGMT];
BasicToUnixTime: PROC [gmt: BasicTime.GMT] RETURNS [INT] ~ {
IF BasicTime.Period[from: gmt, to: baseGMT] > 0 THEN gmt ¬ baseGMT;
TRUSTED {RETURN [LOOPHOLE[UXTime.FromGMT[gmt]]]}};
UnixToBasicTime: PROC [t: INT] RETURNS [BasicTime.GMT] ~ {
t ¬ MIN[t, limitUnixTime];
TRUSTED {RETURN UXTime.ToGMT[LOOPHOLE[t]]}};
RegisterChangeProc: PUBLIC PROC[proc: PROC[data: REF], clientData: REF, ident: ATOM, dbName: ROPE ¬ NIL] = {
block: ProcBlock ¬ NEW[ProcBlockRec];
block.proc ¬ proc;
block.data ¬ clientData;
block.dbName ¬ dbName;
block.ident ¬ ident;
changeProcList ¬ CONS[block, changeProcList];
};
UnregisterChangeProc: PUBLIC PROC[ident: ATOM, dbName: ROPE ¬ NIL] = {
block: ProcBlock ¬ NEW[ProcBlockRec];
l: List.LORA;
blk: ProcBlock;
WHILE TRUE DO
FOR l ¬ changeProcList, l.rest UNTIL l = NIL DO
blk ¬ NARROW[l.first];
IF blk.ident=ident AND Rope.Equal[blk.dbName, dbName, FALSE] THEN {
changeProcList ¬ List.Remove[l.first, changeProcList];
EXIT;
}
ENDLOOP;
ENDLOOP;
};
DatabaseChanged: PROC[db: LoganBerry.OpenDB, entry: LoganBerry.Entry, ident: ATOM, clientData: REF] --LoganBerryExtras.WriteProc-- = {
name: ROPE;
blk: ProcBlock;
name ¬ NARROW[clientData];
FOR l: List.LORA ¬ changeProcList, l.rest UNTIL l = NIL DO
blk ¬ NARROW[l.first];
IF Rope.Equal[blk.dbName, name, FALSE] THEN blk.proc[blk.data];
ENDLOOP;
};
GetDefaultDbName: PUBLIC PROC RETURNS [ROPE]
~ {RETURN [defaultDbName]};
OpenDb: PROC[create: BOOLEAN ¬ FALSE, name: ROPE ¬ NIL] RETURNS [db: LoganBerry.OpenDB ¬ LoganBerry.nullDB, rt: RTable ¬ NIL, usedDbName: ROPE ¬ NIL] = {
dbName: ROPE;
gotBadIndex: BOOL ¬ FALSE;
nl, atpos, retried: INT ¬ 0;
IF name = NIL THEN dbName ¬ defaultDbName ELSE dbName ¬ name;
usedDbName ¬ dbName;
nl ¬ dbName.Length[];
IF (atpos ¬ dbName.Index[s2: "@"]) < nl THEN {
hostName: ROPE ~ dbName.Substr[start: atpos+1];
hostAddrRope: ROPE ~ NetworkName.AddressFromName[$ARPA, hostName, NIL, host !NetworkName.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "NetworkName.Error[%g] looking up host part of db name %g", LIST[[rope[msg]], [rope[dbName]]] ];
GOTO done}].addr;
hostAddr: Arpa.Address ¬ Convert.ArpaAddressFromRope[hostAddrRope
!Convert.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Convert.Error[VAL[%g], near %g] parsing address rope %g from db name %g", LIST[[cardinal[reason.ORD]], [integer[index]], [rope[hostAddrRope]], [rope[dbName]]] ];
GOTO done}];
rhPM: SunRPC.Handle ¬ SunRPCOnUDP.Create[hostAddr, Basics.HFromCard16[SunPMap.udpPort]];
conv: SunRPCAuth.Conversation ¬ SunRPCAuth.Initiate[SunRPCAuth.unixFlavor, SystemNames.UserName[]];
port: CARDINAL ¬ SunPMapClient.GetPort[rhPM, conv, RT.TABLEPROG, RT.TABLEVERS, SunPMap.ipProtocolUDP];
rh: SunRPC.Handle;
IF port=0 THEN {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "no Sun calendar manager daemon (supporting version 3) on %g", [rope[hostName]] ];
GOTO done};
rh ¬ SunRPCOnUDP.SetRemote[rhPM, hostAddr, Basics.HFromCard16[Basics.LowHalf[port]]];
rt ¬ RT.MakeTABLEPROG3Client[rh, conv !
SunRPC.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "SunRPC.Error[%g] importing cm V3 from %g", LIST[[atom[code]], [rope[hostName]]] ];
GOTO done};
SunRPCAuth.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "SunRPCAuth.Error[%g] importing cm V3 from %g", LIST[[atom[code]], [rope[hostName]]] ];
GOTO done}];
rt.rtableping[rt !
SunRPC.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "SunRPC.Error[%g] pinging cm V3 on %g", LIST[[atom[code]], [rope[hostName]]] ];
GOTO done};
SunRPCAuth.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "SunRPCAuth.Error[%g] pinging cm V3 on %g", LIST[[atom[code]], [rope[hostName]]] ];
GOTO done}];
target ¬ dbName;
}
ELSE {
target ¬ NIL;
db ¬ LoganBerry.Open[dbName: dbName ! LoganBerry.Error => {
IF ec=$BadIndex AND retried < 3
THEN {
retried ¬ retried + 1;
gotBadIndex ¬ TRUE;
RETRY;
}
ELSE {
IF ec = $CantOpenSchema OR ec=$CantOpenLog THEN {
IF create AND retried < 3
THEN {
Create[];
retried ¬ retried + 1;
RETRY;
}
ELSE GOTO done;
};
};
}];
IF gotBadIndex THEN
BEGIN
LoganBerry.BuildIndices[db: db];
END;
LoganBerry.RegisterWriteProc[DatabaseChanged, db, $Remind, name];
};
RETURN;
EXITS
done => rt ¬ NIL;
};
AddMeeting: PUBLIC PROC[meeting: Meeting, closeDb: BOOLEAN ¬ TRUE, dbName: ROPE ¬ NIL] RETURNS [id: INT] = {
db: LoganBerry.OpenDB;
rt: RTable;
[db, rt] ¬ OpenDb[create: TRUE, name: dbName];
IF db#LoganBerry.nullDB THEN {
Meetings are stored with meeting.start converted to a 0-padded INT in the start field. The zero-padding is so that loganberry compares yield time order.
entry: LoganBerry.Entry ¬ NIL;
Link: PROC[atom: ATOM, str: ROPE] = {
IF str # NIL AND NOT Rope.IsEmpty[str] THEN {
attr: LoganBerry.Attribute;
attr.type ¬ atom;
attr.value ¬ str;
entry ¬ CONS[attr, entry];
};
};
convert time to an integer and use this as a unique record id
id ¬ IntFromTime[BasicTime.Now[]];
Link[$uniqID, Convert.RopeFromInt[id]];
XXX: will changing timezones goof this up?
Link[$type, meetingTypeNames[meeting.type]];
Link[$start, MyRopeFromInt[IntFromTime[meeting.start]]];
Link[$duration, Convert.RopeFromCard[meeting.duration]];
Link[$explanation, meeting.explanation];
Link[$repeat, repetitionNames[meeting.repeat]];
FOR rl: RemindList ¬ meeting.reminders, rl.rest WHILE rl#NIL DO
WITH rl.first SELECT FROM
x: REF ReminderRecord[alert] => {
Link[$stopReminding, MyRopeFromInt[IntFromTime[x.stop]]];
Link[$startReminding, MyRopeFromInt[IntFromTime[x.start]]];
};
x: REF ReminderRecord[mail] => {
Link[$mailTo, x.to];
Link[$mailAt, MyRopeFromInt[IntFromTime[x.when]]];
};
ENDCASE => ERROR;
ENDLOOP;
Link[$more, meeting.more];
Link[$iconLabel, meeting.iconLabel];
Link[$iconFlavor, meeting.iconFlavor];
Link[$public, Convert.RopeFromBool[meeting.public]];
-- I think the check for DBClosed is obsolete
LoganBerry.WriteEntry[db: db, entry: entry ! LoganBerry.Error =>
{IF ec = $DBClosed THEN {OpenLoganBerry[name: dbName]; RETRY} ELSE REJECT}
];
LoganBerry.WriteEntry[db: db, entry: entry];
XXX:XXX
IF closeDb THEN CloseLoganBerry[db]; -- so autobackup will see a change
}
ELSE IF rt#NIL THEN {
appt: REF RT.Appt;
args: RT.Args;
res: RT.TableRes;
pd: RT.Period ¬ [period: RepsToPeriod[meeting.repeat], nth: 0];
tag: REF RT.Tag ¬ NEW [RT.Tag ¬ [tag: appointment, showtime: 1, next: NIL]];
attrs: REF RT.Attribute ¬ PushReminders[meeting, meeting.reminders,
NEW[RT.Attribute ¬ [
next: NIL,
attr: "cedar-more",
value: meeting.more,
clientdata: NIL]] ];
TRUSTED {appt ¬ NEW[RT.Appt ¬ [
apptid: [tick: BasicToUnixTime[meeting.start], key: 0],
tag: tag,
duration: meeting.duration*60,
ntimes: IF meeting.repeat=once THEN 0 ELSE 999999999,
what: meeting.explanation,
period: pd,
author: NIL,
clientdata: NIL,
exception: NIL,
attr: attrs,
apptstatus: active,
privacy: IF meeting.public THEN public ELSE private,
next: NIL]]};
args ¬ NEW [RT.ArgsObject[APPT] ¬ [APPT[appt]] ];
res ¬ rt.rtableinsert[rt, target, args, UnixSysCalls.GetPID[] ! SunRPC.Error => {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "insert of cm appt failed (%g)", [atom[code]] ];
GOTO dun}];
IF watchAS THEN SELECT res.status FROM
accessok, accessadded => NULL;
ENDCASE => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Insertion into DB %g of meeting at %g failed (%g)", LIST[[rope[dbName]], [time[meeting.start]], [rope[RT.AccessStatusNames[res.status]]]] ];
GOTO dun};
WITH res.res SELECT FROM
x: REF RT.TableResListObject[AP] => id ¬ x.a.apptid.key;
x: REF RT.TableResListObject[ID] => id ¬ x.i.apptid.key;
ENDCASE => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Insertion into DB %g of meeting at %g returned unexpected variant", LIST[[rope[dbName]], [time[meeting.start]]] ];
GOTO dun};
EXITS dun => id ¬ 0;
}
ELSE {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "Unable to open DB %g", [rope[dbName]] ];
id ¬ 0};
};
PushReminders: PROC [meeting: Meeting, rl: RemindList, attr: REF RT.Attribute] RETURNS [REF RT.Attribute] ~ {
FOR rl ¬ rl, rl.rest WHILE rl#NIL DO
nu: REF RT.Attribute ~ NEW [RT.Attribute ¬ WITH rl.first SELECT FROM
x: REF ReminderRecord[alert] => [
next: attr,
attr: "op",
value: Convert.RopeFromInt[BasicTime.Period[from: x.start, to: meeting.start]],
clientdata: NIL],
x: REF ReminderRecord[mail] => [
next: attr,
attr: "ml",
value: Convert.RopeFromInt[BasicTime.Period[from: x.when, to: meeting.start]],
clientdata: x.to],
ENDCASE => ERROR];
attr ¬ nu;
ENDLOOP;
RETURN [attr]};
breakStart: INT ¬ 0;
breakUID: INT ¬ 0;
breaksSeen: INT ¬ 0;
InterpLbAttrs: PROC [aList: LIST OF LoganBerry.Attribute] RETURNS [meeting: Meeting] ~ {
break: BOOL ¬ FALSE;
meeting ¬ NEW[MeetingRec];
WHILE aList#NIL DO
atom: ATOM ~ aList.first.type;
value: ROPE ~ aList.first.value;
aList ¬ aList.rest;
SELECT atom FROM
$uniqID => {
meeting.uniqID ¬ Convert.IntFromRope[value];
IF meeting.uniqID=breakUID THEN break ¬ TRUE};
$type => meeting.type ¬ MeetingTypeFromRope[value];
$start => {i: INT ~ Convert.IntFromRope[value];
meeting.start ¬ TimeFromInt[i];
IF i=breakStart THEN break ¬ TRUE};
$duration => meeting.duration ¬ Convert.CardFromRope[value];
$explanation => meeting.explanation ¬ value;
$repeat => meeting.repeat ¬ RepetitionFromRope[value];
$startReminding => {
x: REF ReminderRecord[alert] ~ NEW [ReminderRecord[alert]];
x.start ¬ TimeFromInt[Convert.IntFromRope[value]];
IF aList#NIL AND aList.first.type=$stopReminding THEN {
x.stop ¬ TimeFromInt[Convert.IntFromRope[aList.first.value]];
aList ¬ aList.rest;
meeting.reminders ¬ CONS[x, meeting.reminders]}
ELSE ERROR BadData[]};
$stopReminding => {
x: REF ReminderRecord[alert] ~ NEW [ReminderRecord[alert]];
x.stop ¬ TimeFromInt[Convert.IntFromRope[value]];
IF aList#NIL AND aList.first.type=$startReminding THEN {
x.start ¬ TimeFromInt[Convert.IntFromRope[aList.first.value]];
aList ¬ aList.rest;
meeting.reminders ¬ CONS[x, meeting.reminders]}
ELSE ERROR BadData[]};
$more => meeting.more ¬ value;
$iconLabel => meeting.iconLabel ¬ value;
$iconFlavor => meeting.iconFlavor ¬ value;
$public => meeting.public ¬ Rope.Equal[value, "TRUE"];
$mailAt => {
x: REF ReminderRecord[mail] ~ NEW [ReminderRecord[mail]];
x.when ¬ TimeFromInt[Convert.IntFromRope[value]];
IF aList#NIL AND aList.first.type=$mailTo THEN {
x.to ¬ aList.first.value;
aList ¬ aList.rest}
ELSE x.to ¬ "user@host";
meeting.reminders ¬ CONS[x, meeting.reminders]};
ENDCASE => ERROR BadData[];
ENDLOOP;
IF break THEN breaksSeen ¬ breaksSeen + 1;
RETURN};
make two passes
ListMeetings: PUBLIC PROC [
from, to: BasicTime.GMT,
all: BOOLEAN ¬ FALSE,
dbName: ROPE ¬ NIL
] RETURNS [ls: LIST OF Meeting ¬ NIL] = {
cursor: LoganBerry.Cursor;
entry: LoganBerry.Entry;
meeting, meeting1: Meeting;
lim: INT;
db: LoganBerry.OpenDB;
rt: RTable;
usedDbName: ROPE;
[db, rt, usedDbName] ¬ OpenDb[name: dbName];
-XXX: this is a royal kludge: FirstOccurrenceAfter substracts by 1 year, so add 1 year here to avoid BasicTimeImpl.OutOfRange ERROR (note that TimeParse.Adjust won't work, because it interprets earliestGMT as Now).
IF BasicTime.Period[from: BasicTime.earliestGMT, to: from] < BasicTime.secondsPerYear THEN from ¬ BasicTime.Update[BasicTime.earliestGMT, BasicTime.secondsPerYear];
lim ¬ IntFromTime[to];
IF db#LoganBerry.nullDB THEN {
first pass: find all one time meetings
cursor ¬ LoganBerry.GenerateEntries[
db: db,
start: MyRopeFromInt[IntFromTime[from]],
end: MyRopeFromInt[IntFromTime[to]],
key: $start
];
WHILE (entry ¬ LoganBerry.NextEntry[cursor: cursor]) # NIL DO
meeting ¬ InterpLbAttrs[entry];
IF meeting.repeat = once THEN ls ¬ CONS[meeting, ls];
ENDLOOP;
LoganBerry.EndGenerate[cursor: cursor];
second pass: find all repeated meetings
FOR rep: Repetitions IN [daily..LAST[Repetitions]] DO
cursor ¬ LoganBerry.GenerateEntries[
db: db,
start: repetitionNames[rep], -- RopeFromRepetition[rep]:
end: repetitionNames[rep],
key: $repeat];
WHILE (entry ¬ LoganBerry.NextEntry[cursor: cursor]) # NIL DO
newReminders: BOOL ¬ FALSE;
newStart: BasicTime.GMT;
meeting ¬ InterpLbAttrs[entry];
newStart ¬ FirstOccurrenceAfter[rep, meeting.nth, meeting.start, from];
WHILE IntFromTime[newStart] <= lim DO
UpdateMeeting[meeting, newStart, TRUE, newReminders];
ls ¬ CONS[meeting, ls];
IF NOT all THEN EXIT;
meeting1 ¬ meeting;
meeting ¬ NEW[MeetingRec ¬ meeting1­];
newStart ¬ NextOccurrence[rep, meeting.nth, meeting.start];
newReminders ¬ TRUE;
ENDLOOP;
ENDLOOP;
LoganBerry.EndGenerate[cursor: cursor];
ENDLOOP;
}
ELSE IF rt#NIL THEN {
range: RT.Range ~ [
key1: BasicToUnixTime[from],
key2: BasicToUnixTime[to],
next: NIL];
seen: IntHashTable.Table ~ IF all THEN NIL ELSE IntHashTable.Create[];
PassAppt: PROC [appt: REF RT.Appt] RETURNS [BOOL] ~ {
IF range.key1<=appt.apptid.tick AND appt.apptid.tick<=range.key2 AND (all OR seen.Insert[appt.apptid.key, $T])
THEN ls ¬ CONS[ApptToMtg[appt], ls];
RETURN [FALSE]};
ScanAppts[rt, usedDbName, PassAppt, "ListMeetings", range.key1, range.key2];
RETURN};
};
ApptToMtg: PROC [appt: REF RT.Appt] RETURNS [mtg: Meeting] ~ {
mtg ¬ NEW [MeetingRec ¬ [
uniqID: appt.apptid.key,
type: meeting,
start: UnixToBasicTime[appt.apptid.tick],
duration: MAX[(appt.duration+30)/60, 1],
explanation: appt.what,
repeat: PeriodToReps[appt.period.period],
public: appt.privacy = public,
other: NIL]];
FOR attr: REF RT.Attribute ¬ appt.attr, attr.next WHILE attr#NIL DO
IF attr.attr.Equal["cedar-more"] THEN mtg.more ¬ attr.value
ELSE IF attr.attr.Length>0 THEN SELECT attr.attr.Fetch[0] FROM
'b, 'f, 'm, 'o => {r: ROPE ¬ attr.attr;
alert, mail: BOOL ¬ FALSE;
IF Rope.IsPrefix["bp", r] THEN {r ¬ r.Substr[2]; alert ¬ TRUE};
IF Rope.IsPrefix["fl", r] THEN {r ¬ r.Substr[2]; alert ¬ TRUE};
IF Rope.IsPrefix["op", r] THEN {r ¬ r.Substr[2]; alert ¬ TRUE};
IF Rope.IsPrefix["ml", r] THEN {r ¬ r.Substr[2]; mail ¬ TRUE};
IF r.Length[] = 0 THEN {
adv: INT ¬ Convert.IntFromRope[attr.value !Convert.Error => GOTO Not];
start: BasicTime.GMT ¬ BasicTime.Update[mtg.start, -adv];
IF alert THEN {
x: Reminder ~ NEW [ReminderRecord ¬ [NIL, alert[start, mtg.start]]];
mtg.reminders ¬ CONS[x, mtg.reminders]};
IF mail THEN {
x: Reminder ~ NEW [ReminderRecord ¬ [NIL, mail[start, attr.clientdata]]];
mtg.reminders ¬ CONS[x, mtg.reminders]};
};
EXITS Not => mtg ¬ mtg};
ENDCASE => NULL;
ENDLOOP;
RETURN};
EnumerateAppts: PROC [rt: RTable, res: RT.TableResList, PerAppt: PROC [REF RT.Appt] RETURNS [BOOL]] RETURNS [empty: BOOL ¬ TRUE] ~ {
TryLookup: PROC [of: RT.Args, apptid: RT.Id] RETURNS [stop: BOOL ¬ FALSE] ~ {
ires: RT.TableRes;
ires ¬ rt.rtablelookup[rt, target, of, UnixSysCalls.GetPID[] !SunRPC.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "lookup of abbreviated appointment (tick=%x=%g, key=%g) => RPC.Error[%g]", LIST[[integer[apptid.tick]], [time[UnixToBasicTime[apptid.tick]]], [integer[apptid.key]], [atom[code]]] ];
GOTO Fale}];
IF watchAS THEN SELECT ires.status FROM
accessok, accessexists => NULL;
ENDCASE => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "lookup of abbreviated appointment (tick=%x=%g, key=%g) failed, with status=%g", LIST[[integer[apptid.tick]], [time[UnixToBasicTime[apptid.tick]]], [integer[apptid.key]], [rope[RT.AccessStatusNames[ires.status]]]] ];
RETURN [TRUE]};
WITH ires.res SELECT FROM
y: REF RT.TableResListObject[AP] => stop ¬ PerAppt[y.a];
ENDCASE => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "lookup of abbreviated appointment (tick=%x=%g, key=%g) returned unexpected variant (%g)", LIST[[integer[apptid.tick]], [time[UnixToBasicTime[apptid.tick]]], [integer[apptid.key]], [rope[RT.TableResTypeNames[ires.res.tag]]]] ];
RETURN [TRUE]};
RETURN;
EXITS Fale => stop ¬ TRUE};
WITH res SELECT FROM
x: REF RT.TableResListObject[AP] => {
FOR appt: REF RT.Appt ¬ x.a, appt.next WHILE appt#NIL DO
empty ¬ FALSE;
SELECT appt.tag.tag FROM
appointment, otherTag, toDo => {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "Enum appt[tick=%x=%g, key=%g, what=%g]", LIST[[integer[appt.apptid.tick]], [time[UnixToBasicTime[appt.apptid.tick]]], [integer[appt.apptid.key]], [rope[appt.what]]] ];
IF PerAppt[appt] THEN EXIT;
};
reminder => {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "Enum reminder[tick=%x=%g, key=%g, what=%g]", LIST[[integer[appt.apptid.tick]], [time[UnixToBasicTime[appt.apptid.tick]]], [integer[appt.apptid.key]], [rope[appt.what]]] ];
};
holiday => {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "Enum holiday[tick=%x=%g, key=%g, what=%g]", LIST[[integer[appt.apptid.tick]], [time[UnixToBasicTime[appt.apptid.tick]]], [integer[appt.apptid.key]], [rope[appt.what]]] ];
};
ENDCASE => ERROR;
ENDLOOP};
x: REF RT.TableResListObject[AB] => {
FOR aba: REF RT.AbbAppt ¬ x.b, aba.next WHILE aba#NIL DO
empty ¬ FALSE;
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "Enum abb-appt[tick=%x=%g, key=%g, what=%g]", LIST[[integer[aba.apptid.tick]], [time[UnixToBasicTime[aba.apptid.tick]]], [integer[aba.apptid.key]], [rope[aba.what]]] ];
IF TryLookup[NEW[RT.ArgsObject[UID] ¬ [UID[NEW[RT.Uid ¬ [aba.apptid, NIL]] ]]], aba.apptid ] THEN EXIT;
ENDLOOP};
x: REF RT.TableResListObject[ID] => {
FOR uid: REF RT.Uid ¬ x.i, uid.next WHILE uid#NIL DO
empty ¬ FALSE;
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "Enum uid[tick=%x=%g, key=%g]", LIST[[integer[uid.apptid.tick]], [time[UnixToBasicTime[uid.apptid.tick]]], [integer[uid.apptid.key]]] ];
IF TryLookup[NEW[RT.ArgsObject[UID] ¬ [UID[uid]]], uid.apptid ] THEN EXIT;
ENDLOOP};
ENDCASE => SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "enumerating unexpected variant (%g)", [rope[RT.TableResTypeNames[res.tag]]] ];
};
secsPerWeek: INT ¬ 3600*168;
watchAS: BOOL ¬ FALSE;
debug: BOOL ¬ FALSE;
scanStyle: {dualRanges, cachedIntervals, nextLarger} ¬ dualRanges;
useAbb: BOOL ¬ FALSE;
ScanAppts: PROC [rt: RTable, usedDbName: ROPE, PerAppt: PROC [REF RT.Appt] RETURNS [BOOL], for: ROPE, min: INT ¬ 0, max: INT ¬ limitUnixTime-1] ~ {
SELECT scanStyle FROM
dualRanges => {
now: INT ~ BasicToUnixTime[BasicTime.Now[]];
delt: INT ¬ secsPerWeek;
sofar: INT ¬ MIN[now-1, max]+1;
WHILE min < sofar DO -- [sofar, MIN[now-1, max]] already done
qmin: INT ¬ MAX[MAX[min, sofar-delt]-1, 0];
qmax: INT ¬ sofar;
args: RT.Args ¬ NEW [RT.ArgsObject[RANGE] ¬ [RANGE[NEW[RT.Range ¬ [qmin, qmax, NIL]] ]]];
res: RT.TableRes ¬
(IF useAbb THEN rt.rtableabbreviatedlookuprange ELSE rt.rtablelookuprange)
[rt, target, args, UnixSysCalls.GetPID[]
!SunRPC.Error => {
SimpleFeedback.Append[$RemindImpl, oneLiner, $Error, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g on %g => RPC.Error[%g]", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]], [rope[usedDbName]], [atom[code]] ]]];
EXIT}];
IF watchAS THEN SELECT res.status FROM
accessok => IF debug THEN SimpleFeedback.Append[$RemindImpl, oneLiner, $Debug, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g succeeds", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]] ]]];
ENDCASE => {
SimpleFeedback.Append[$RemindImpl, oneLiner, $Error, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g on %g => status = %g", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]], [rope[usedDbName]], [rope[RT.AccessStatusNames[res.status]]] ]]];
EXIT};
IF EnumerateAppts[rt, res.res, PerAppt] THEN delt ¬ 2*MIN[delt, LAST[INT]/4];
sofar ¬ qmin;
ENDLOOP;
NULL -- [min, MIN[now-1, max]] already queried--;
sofar ¬ MAX[now, min]-1;
delt ¬ secsPerWeek;
WHILE sofar < max DO --[MAX[now, min], sofar] already done
qmin: INT ¬ sofar;
qmax: INT ¬ MIN[max, sofar+delt]+1;
args: RT.Args ¬ NEW [RT.ArgsObject[RANGE] ¬ [RANGE[NEW[RT.Range ¬ [qmin, qmax, NIL]] ]]];
res: RT.TableRes ¬
(IF useAbb THEN rt.rtableabbreviatedlookuprange ELSE rt.rtablelookuprange)
[rt, target, args, UnixSysCalls.GetPID[]
!SunRPC.Error => {
SimpleFeedback.Append[$RemindImpl, oneLiner, $Error, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g on %g => RPC.Error[%g]", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]], [rope[usedDbName]], [atom[code]] ]]];
EXIT}];
IF watchAS THEN SELECT res.status FROM
accessok => IF debug THEN SimpleFeedback.Append[$RemindImpl, oneLiner, $Debug, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g succeeds", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]] ]]];
ENDCASE => {
SimpleFeedback.Append[$RemindImpl, oneLiner, $Error, IO.PutFLR["cm lookuprange[%x=%g, %x=%g] for %g on %g => status = %g", LIST[ [integer[qmin]], [time[UnixToBasicTime[qmin]]], [integer[qmax]], [time[UnixToBasicTime[qmax]]], [rope[for]], [rope[usedDbName]], [rope[RT.AccessStatusNames[res.status]]] ]]];
EXIT};
IF EnumerateAppts[rt, res.res, PerAppt] THEN delt ¬ 2*MIN[delt, (LAST[INT]-sofar)/4];
sofar ¬ qmax;
ENDLOOP;
NULL--[MAX[now, min], max] queried--};
cachedIntervals => {
stack: REF RT.Range ¬ NEW [RT.Range ¬ [min, max, NIL]];
WHILE stack#NIL DO
probe: REF RT.Range ¬ stack;
bad: BOOL ¬ IntervalIsBad[usedDbName, probe];
stack ¬ stack.next;
probe.next ¬ NIL;
IF NOT bad THEN {
args: RT.Args ~ NEW [RT.ArgsObject[RANGE] ¬ [RANGE[probe]]];
res: RT.TableRes ~ rt.rtableabbreviatedlookuprange[rt, target, args, UnixSysCalls.GetPID[]
!SunRPC.Error => IF probe.key2-probe.key1 <= 86400
THEN {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "cm lookuprange[%g, %g] for %g on %g => RPC.Error[%g]", LIST[[integer[probe.key1]], [integer[probe.key2]], [rope[for]], [rope[usedDbName]], [atom[code]]] ];
EXIT}
ELSE {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Warning, "cm lookuprange[%g, %g] for %g on %g -> RPC.Error[%g], trying smaller range", LIST[[integer[probe.key1]], [integer[probe.key2]], [rope[for]], [rope[usedDbName]], [atom[code]]] ];
GOTO Bad}];
IF watchAS THEN SELECT res.status FROM
accessok => NULL;
accesspartial => GOTO Bad;
ENDCASE => IF probe.key2-probe.key1 <= 86400
THEN {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "cm lookuprange[%g, %g] for %g on %g => status = %g", LIST[[integer[probe.key1]], [integer[probe.key2]], [rope[for]], [rope[usedDbName]], [rope[RT.AccessStatusNames[res.status]]]] ];
EXIT}
ELSE {
mid: CARD ~ (CARD[probe.key1]+CARD[probe.key2])/2;
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Warning, "cm lookuprange[%g, %g] for %g on %g -> status = %g, trying smaller range", LIST[[integer[probe.key1]], [integer[probe.key2]], [rope[for]], [rope[usedDbName]], [rope[RT.AccessStatusNames[res.status]]]] ];
GOTO Bad};
[] ¬ EnumerateAppts[rt, res.res, PerAppt];
EXITS Bad => {
AssertBad[usedDbName, probe];
bad ¬ TRUE}};
IF bad THEN {
mid: CARD ~ (CARD[probe.key1]+CARD[probe.key2])/2;
stack ¬ NEW[RT.Range ¬ [probe.key1, mid,
NEW[RT.Range ¬ [mid, probe.key2, stack]] ]]};
ENDLOOP};
nextLarger => {
seekTick: INT ¬ min;
args: RT.Args ¬ NEW [RT.ArgsObject[TICK3] ¬ [TICK3[min]]];
DO
res: RT.TableRes ~ rt.rtablelookupnextlarger[rt, target, args, UnixSysCalls.GetPID[]
!SunRPC.Error => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "lookup[%x=%g] for scan (for %g) failed (%g)", LIST[[integer[seekTick]], [time[UnixToBasicTime[seekTick]]], [rope[for]], [atom[code]]] ];
EXIT}];
IF watchAS THEN SELECT res.status FROM
accessok => NULL;
ENDCASE => {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "LookupNextLarger[tick=%x=%g] => status=%g", LIST[[integer[seekTick]], [time[UnixToBasicTime[seekTick]]], [rope[RT.AccessStatusNames[res.status]]]] ];
EXIT};
WITH res.res SELECT FROM
x: REF RT.TableResListObject[AP] => IF x.a=NIL
THEN {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "LookupNextLarger[tick=%x=%g] => NIL", LIST[[integer[seekTick]], [time[UnixToBasicTime[seekTick]]]] ];
EXIT}
ELSE {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "LookupNextLarger[tick=%x=%g] => tick=%x=%g key=%g", LIST[[integer[seekTick]], [time[UnixToBasicTime[seekTick]]], [integer[x.a.apptid.tick]], [time[UnixToBasicTime[x.a.apptid.tick]]], [integer[x.a.apptid.key]]] ];
IF x.a.apptid.tick > max THEN EXIT;
IF PerAppt[x.a] THEN EXIT;
seekTick ¬ x.a.apptid.tick;
args ¬ NEW[RT.ArgsObject[TICK3] ¬ [TICK3[x.a.apptid.tick]]]};
ENDCASE => {
SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "scanning unexpected variant (%g) (for %g)", LIST[[rope[RT.TableResTypeNames[res.res.tag]]], [rope[for]]] ];
EXIT};
ENDLOOP};
ENDCASE => ERROR;
RETURN};
DeleteMeeting: PUBLIC PROC[start: BasicTime.GMT, id: INT, closeDb: BOOLEAN ¬ TRUE, dbName: Rope.ROPE ¬ NIL] RETURNS [found: BOOLEAN ¬ FALSE]
= {RETURN DeleteMeetingInRange[start, start, id, closeDb, dbName]};
DeleteMeetingInRange: PUBLIC PROC[from, to: BasicTime.GMT, id: INT, closeDb: BOOLEAN ¬ TRUE, dbName: Rope.ROPE ¬ NIL] RETURNS [found: BOOLEAN ¬ FALSE] = {
db: LoganBerry.OpenDB;
rt: RTable;
usedDbName: ROPE;
DeleteThis: PROC [start: BasicTime.GMT, unixStart: INT] RETURNS [found: BOOL ¬ FALSE] ~ {
args: RT.Args ¬ NEW [RT.ArgsObject[UID] ¬ [UID[NEW[RT.Uid ¬ [[tick: unixStart, key: id], NIL]] ]]];
res: RT.TableRes ¬ rt.rtabledelete[rt, target, args, UnixSysCalls.GetPID[] !SunRPC.Error => {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "delete rpc failed (%g)", [atom[code]] ];
GOTO Bail}];
SELECT res.status FROM
accessok, accessremoved => found ¬ TRUE;
ENDCASE => {
found ¬ FALSE;
IF watchAS THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Delete (by id) of message (tick=%xH=%g, key=%g) failed (status = %g)", LIST[[integer[unixStart]], [time[UnixToBasicTime[unixStart]]], [integer[id]], [rope[RT.AccessStatusNames[res.status]]]] ];
};
EXITS Bail => found ¬ FALSE};
[db, rt, usedDbName] ¬ OpenDb[name: dbName];
IF db # LoganBerry.nullDB THEN {
entry: LoganBerry.Entry;
idVal: ROPE ~ Convert.RopeFromInt[id];
others: BOOL;
[entry, others] ¬ LoganBerry.ReadEntry[db: db, key: $uniqID, value: idVal];
IF others THEN ERROR;
IF entry#NIL THEN {
LoganBerry.DeleteEntry[db: db, key: $uniqID, value: idVal];
found ¬ TRUE;
};
XXX:XXX
IF closeDb THEN CloseLoganBerry[db]; -- so autobackup will see a change
RETURN [found]}
ELSE IF rt=NIL THEN RETURN [FALSE]
ELSE IF from=to THEN RETURN DeleteThis[from, BasicToUnixTime[from]]
ELSE {
unixFrom: INT ~ BasicToUnixTime[from];
unixTo: INT ~ BasicToUnixTime[to];
args: RT.Args ¬ NEW [RT.ArgsObject[KEYRANGE] ¬ [KEYRANGE[NEW[RT.Keyrange ¬ [key: id, tick1: unixFrom, tick2: unixTo, next: NIL]] ]]];
res: RT.TableRes ¬ rt.rtableabbreviatedlookupkeyrange[rt, target, args, UnixSysCalls.GetPID[] !SunRPC.Error => {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "abb-lookup-keyrange rpc failed (%g)", [atom[code]] ];
GOTO Bail}];
IF watchAS THEN SELECT res.status FROM
accessok => NULL;
ENDCASE => {
IF debug THEN SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Debug, "abb-lookup-keyrange[key=%g, tick1=%g, tick2=%g] => status=%g", LIST[[integer[id]], [time[from]], [time[to]], [rope[RT.AccessStatusNames[res.status]]]] ];
GOTO Bail};
WITH res.res SELECT FROM
x: REF RT.TableResListObject[AB] => {
IF x.b=NIL THEN found ¬ FALSE
ELSE found ¬ DeleteThis[UnixToBasicTime[x.b.apptid.tick], x.b.apptid.tick]};
ENDCASE => SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "delete-in-range got unexpected variant (%g)", [rope[RT.TableResTypeNames[res.res.tag]]] ];
RETURN;
EXITS Bail => found ¬ FALSE};
};
<<DeleteMeeting: PUBLIC PROC[
meeting: Meeting,
closeDb: BOOLEAN ¬ TRUE,
dbName: ROPE ¬ NIL] RETURNS [found: BOOLEAN ¬ FALSE] = {
cursor: LoganBerry.Cursor;
id: ROPE;
entry: LoganBerry.Entry;
db: LoganBerry.OpenDB;
rt: RTable; usedDbName: ROPE;
[db, rt, usedDbName] ¬ OpenDb[name: dbName];
IF db # LoganBerry.nullDB THEN {
cursor ¬ LoganBerry.GenerateEntries[db: db, key: $uniqID];
WHILE (entry ¬ LoganBerry.NextEntry[cursor: cursor]) # NIL DO
startMatch: BOOLEAN ¬ FALSE;
explMatch: BOOL ¬ meeting.explanation.Length[] = 0;
id ¬ NIL;
FOR aList: LIST OF LoganBerry.Attribute ¬ entry, aList.rest UNTIL aList = NIL DO
SELECT aList.first.type FROM
$uniqID => id ¬ aList.first.value;
$start => IF TimeFromInt[Convert.IntFromRope[aList.first.value]] = meeting.start THEN startMatch ¬ TRUE;
$explanation => IF Rope.Equal[meeting.explanation, aList.first.value] THEN explMatch ¬ TRUE;
ENDCASE => {};
ENDLOOP;
IF id.Equal[stopID] THEN stops ¬ stops+1;
IF explMatch AND startMatch AND id#NIL THEN {
LoganBerry.DeleteEntry[db: db, key: $uniqID, value: id];
found ¬ TRUE;
};
ENDLOOP;
LoganBerry.EndGenerate[cursor: cursor];
IF closeDb THEN CloseLoganBerry[db]; -- so autobackup will see a change
RETURN [found]}
ELSE IF rt#NIL THEN {
doomedTicks: INT ¬ BasicToUnixTime[meeting.start];
doomed: LIST OF REF RT.Appt ¬ NIL;
NoteAppt: PROC [appt: REF RT.Appt] RETURNS [BOOL] ~ {
IF appt.apptid.key = meeting.uniqID THEN {
doomed ¬ CONS[appt, doomed];
found ¬ TRUE};
RETURN[FALSE]};
ScanAppts[rt, usedDbName, NoteAppt, "DeleteMeeting", doomedTicks, doomedTicks];
FOR dl: LIST OF REF RT.Appt ¬ doomed, dl.rest WHILE dl#NIL DO
args: RT.Args ¬ NEW [RT.ArgsObject[UID] ¬ [UID[NEW[RT.Uid ¬ [dl.first.apptid, NIL]] ]]];
res: RT.TableRes ¬ rt.rtabledelete[rt, target, args, UnixSysCalls.GetPID[] !SunRPC.Error => {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "delete rpc failed (%g)", [atom[code]] ];
EXIT}];
IF watchAS THEN SELECT res.status FROM
accessok, accessremoved => NULL;
ENDCASE => SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Delete of message (tick=%xH=%g, key=%g) failed (status = %g)", LIST[[integer[dl.first.apptid.tick]], [time[UnixToBasicTime[dl.first.apptid.tick]]], [integer[dl.first.apptid.key]], [rope[RT.AccessStatusNames[res.status]]]] ];
ENDLOOP;
}
ELSE RETURN [FALSE]};
stopID: ROPE ¬ NIL;
stops: CARD ¬ 0;
DeleteMeetingByID: PUBLIC PROC[from, to: BasicTime.GMT, id: INT, closeDb: BOOLEAN ¬ TRUE, dbName: Rope.ROPE ¬ NIL] RETURNS [found: BOOLEAN ¬ FALSE] = {
db: LoganBerry.OpenDB;
rt: RTable;
usedDbName: ROPE;
[db, rt, usedDbName] ¬ OpenDb[name: dbName];
IF db # LoganBerry.nullDB THEN {
cursor: LoganBerry.Cursor;
entry: LoganBerry.Entry;
cursor ¬ LoganBerry.GenerateEntries[db: db, key: $uniqID];
BEGIN -- establish scope for EXIT clause
WHILE (entry ¬ LoganBerry.NextEntry[cursor: cursor]) # NIL DO
FOR aList: LIST OF LoganBerry.Attribute ¬ entry, aList.rest UNTIL aList = NIL DO
IF aList.first.type = $uniqID THEN {
IF stopID.Equal[aList.first.value] THEN stops ¬ stops+1;
IF Convert.IntFromRope[aList.first.value] = id THEN {
LoganBerry.DeleteEntry[db: db, key: $uniqID, value: Convert.RopeFromInt[id]];
found ¬ TRUE;
GOTO done;
}
ELSE
EXIT;
};
ENDLOOP;
ENDLOOP;
EXITS
done => {};
END;
LoganBerry.EndGenerate[cursor: cursor];
XXX:XXX
IF closeDb THEN CloseLoganBerry[db]; -- so autobackup will see a change
RETURN [found]}
ELSE IF rt#NIL THEN {
qmin: INT ~ BasicToUnixTime[from];
qmax: INT ~ BasicToUnixTime[to];
doomed: LIST OF REF RT.Appt ¬ NIL;
NoteAppt: PROC [appt: REF RT.Appt] RETURNS [BOOL] ~ {
IF appt.apptid.key = id THEN doomed ¬ CONS[appt, doomed];
RETURN[FALSE]};
ScanAppts[rt, usedDbName, NoteAppt, "DeleteMeetingByID", qmin, qmax];
FOR dl: LIST OF REF RT.Appt ¬ doomed, dl.rest WHILE dl#NIL DO
args: RT.Args ¬ NEW [RT.ArgsObject[UID] ¬ [UID[NEW[RT.Uid ¬ [dl.first.apptid, NIL]] ]]];
res: RT.TableRes ¬ rt.rtabledelete[rt, target, args, UnixSysCalls.GetPID[] !SunRPC.Error => {
SimpleFeedback.PutF[$RemindImpl, oneLiner, $Error, "delete rpc failed (%g)", [atom[code]] ];
EXIT}];
IF watchAS THEN SELECT res.status FROM
accessok, accessremoved => NULL;
ENDCASE => SimpleFeedback.PutFL[$RemindImpl, oneLiner, $Error, "Delete (by id) of message (tick=%xH=%g, key=%g) failed (status = %g)", LIST[[integer[dl.first.apptid.tick]], [time[UnixToBasicTime[dl.first.apptid.tick]]], [integer[dl.first.apptid.key]], [rope[RT.AccessStatusNames[res.status]]]] ];
ENDLOOP;
}
ELSE RETURN [FALSE]};>>
Create: PROC = {
userCred: ROPE ¬ SystemNames.UserName[];
s: IO.STREAM;
baseName, logName: ROPE;
credIndex: INT;
ind: INT ¬ Rope.FindBackward[defaultDbName, "/"];
SimpleFeedback.PutF[$Remind, oneLiner, $Info, "Creating CalendarTool database file: %g\n", [rope[defaultDbName]] ];
IF ind # -1 THEN baseName ¬ Rope.Substr[defaultDbName, ind+1] ELSE baseName ¬ defaultDbName;
baseName ¬ Rope.Substr[baseName, 0, Rope.Index[baseName, 0, "."]];
s ¬ FS.StreamOpen[defaultDbName, $create];
s.PutF1["-- %g\n\n", IO.rope[defaultDbName]];
credIndex ¬ Rope.FindBackward[userCred, ".pa"];
IF credIndex # -1 THEN userCred ¬ Rope.Substr[userCred, 0, credIndex];
s.PutF1["Directory [User]<%g>Top>\n", IO.rope[userCred]];
s.PutF1["\t\t%g\n", IO.rope[Rope.Substr[defaultDbName, Rope.FindBackward[defaultDbName, "/"]+1]]];
s.PutF["Directory [User]<%g>%g>\n", IO.rope[userCred], IO.rope[baseName]];
s.PutF1[" --> log 0 readwrite\n\t\t%g.lblog\n", IO.rope[baseName]];
s.PutF1[" --> index \"uniqID\" primary\n\t\t%g.uniqID.lbindex\n", IO.rope[baseName]];
s.PutF1[" --> index \"start\" secondary\n\t\t%g.start.lbindex\n", IO.rope[baseName]];
s.PutF1[" --> index \"repeat\" secondary\n\t\t%g.repeat.lbindex\n", IO.rope[baseName]];
s.PutF1[" --> index \"stopReminding\" secondary\n\t\t%g.stopReminding.lbindex\n", IO.rope[baseName]];
IO.Close[s];
logName ¬ Rope.Cat[Rope.Substr[defaultDbName, 0, ind+1], baseName, ".lblog"];
s ¬ FS.StreamOpen[logName, $create];
s.PutRope["\377"];
IO.Close[s];
};
NextOccurrence: PUBLIC PROC[repeat: Repetitions, nth: INT, time: BasicTime.GMT] RETURNS [BasicTime.GMT] = {
SELECT repeat FROM
once => RETURN[time];
daily, everyNthDay =>
RETURN[TimeParse.Adjust[baseTime: time, precisionOfResult: seconds, days: IF repeat=daily THEN 1 ELSE nth].time];
weekly, everyNthWeek =>
RETURN[TimeParse.Adjust[baseTime: time, precisionOfResult: seconds, days: IF repeat=weekly THEN 7 ELSE (nth*7)].time];
biweekly =>
RETURN[TimeParse.Adjust[baseTime: time, precisionOfResult: seconds, days: 14].time];
monthly, everyNthMonth =>
RETURN[TimeParse.Adjust[baseTime: time, precisionOfResult: seconds, months: IF repeat=monthly THEN 1 ELSE nth].time];
yearly =>
RETURN[TimeParse.Adjust[baseTime: time, precisionOfResult: seconds, years: 1].time];
weekdays, nthWeekday => {
t: BasicTime.GMT ¬ time;
IF repeat=weekdays THEN nth ¬ 1;
WHILE TRUE DO
t ¬ TimeParse.Adjust[baseTime: t, precisionOfResult: seconds, days: 1].time;
IF BasicTime.Unpack[t].weekday IN [Monday .. Friday] THEN {
nth ¬ nth - 1;
IF nth=0 THEN EXIT};
ENDLOOP;
RETURN[t];
};
ENDCASE => RETURN[time]; -- should never get here
};
FirstOccurrenceAfter: PUBLIC PROC[repeat: Repetitions, nth: INT, init, now: BasicTime.GMT] RETURNS [BasicTime.GMT] = {
initMinus: BasicTime.GMT;
secondsPerDay: INT = BasicTime.secondsPerMinute*BasicTime.minutesPerHour*BasicTime.hoursPerDay;
secondsPerWeek: INT = secondsPerDay*7;
secondsPerTwoWeeks: INT = secondsPerWeek*2;
secondsPerYear: INT = secondsPerDay*365;
diff: INT;
ByDay: PROC [days: INT] RETURNS [BasicTime.GMT] ~ {
secsPerPeriod: INT ~ secondsPerDay*days;
diff: INT ¬ BasicTime.Period[init, now]/secsPerPeriod + 1;
init ¬ TimeParse.Adjust[baseTime: init, days: diff*days, precisionOfResult: seconds].time;
because of daylights savings time, might be off by 1
IF BasicTime.Period[now, init] < 0 THEN init ¬ TimeParse.Adjust[baseTime: init, days: days, precisionOfResult: seconds].time
ELSE {
initMinus ¬ TimeParse.Adjust[baseTime: init, days: -days, precisionOfResult: seconds].time;
IF BasicTime.Period[now, initMinus] >= 0 THEN init ¬ initMinus;
};
RETURN[init]};
SELECT repeat FROM
once => RETURN[init];
daily => RETURN ByDay[1];
everyNthDay => RETURN ByDay[nth];
weekly => RETURN ByDay[7];
biweekly => RETURN ByDay[14];
everyNthWeek => RETURN ByDay[7*nth];
monthly, everyNthMonth => {
uInit, uNow: BasicTime.Unpacked;
secsInit, secsNow: INT;
IF repeat=monthly THEN nth ¬ 1;
uInit ¬ BasicTime.Unpack[init];
uNow ¬ BasicTime.Unpack[now];
diff ¬ (uNow.year - uInit.year)*12 + ORD[uNow.month] - ORD[uInit.month];
diff ¬ ((diff+nth-1)/nth)*nth;
compute seconds since beginning of month
secsInit ¬ uInit.second + 60*uInit.minute + 60*60*uInit.hour + secondsPerDay*ORD[uInit.day];
secsNow ¬ uNow.second + 60*uNow.minute + 60*60*uNow.hour + secondsPerDay*ORD[uNow.day];
IF secsInit < secsNow THEN diff ¬ diff + nth;
init ¬ TimeParse.Adjust[baseTime: init, months: diff, precisionOfResult: seconds].time;
RETURN[init];
};
yearly => {
diff ¬ BasicTime.Period[init, now]/secondsPerYear + 1;
init ¬ TimeParse.Adjust[baseTime: init, years: diff, precisionOfResult: seconds].time;
because of leap years, might be off by 1
IF BasicTime.Period[now, init] < 0 THEN init ¬ TimeParse.Adjust[baseTime: init, years: 1, precisionOfResult: seconds].time
ELSE {
initMinus ¬ TimeParse.Adjust[baseTime: init, years: -1, precisionOfResult: seconds].time;
IF BasicTime.Period[now, initMinus] >= 0 THEN
init ¬ initMinus;
};
RETURN[init];
};
weekdays, nthWeekday => {
u: BasicTime.Unpacked;
IF repeat=weekdays THEN nth ¬ 1;
DO
init ¬ ByDay[1];
u ¬ BasicTime.Unpack[init];
IF u.weekday= Saturday THEN
init ¬ TimeParse.Adjust[baseTime: init, days: 2, precisionOfResult: seconds].time
ELSE IF u.weekday= Sunday THEN
init ¬ TimeParse.Adjust[baseTime: init, days: 1, precisionOfResult: seconds].time;
IF (nth ¬ nth-1) = 0 THEN RETURN[init];
ENDLOOP;
};
ENDCASE => RETURN[init]; -- should never get here
};
UpdateMeeting: PROC[meeting: Meeting, newTime: BasicTime.GMT, remindersToo, newReminders: BOOL] = {
diff: INT ¬ BasicTime.Period[meeting.start, newTime];
UpdateReminders: PROC [rl: RemindList] RETURNS [RemindList] ~ {
IF rl=NIL THEN RETURN [NIL];
WITH rl.first SELECT FROM
x: AlertReminder => RETURN [CONS[
NEW [ReminderRecord[alert] ¬ [x.other, alert[
start: BasicTime.Update[x.start, diff],
stop: BasicTime.Update[x.stop, diff] ]]],
UpdateReminders[rl.rest] ]];
x: MailReminder => RETURN [CONS[
NEW [ReminderRecord[mail] ¬ [x.other, mail[
when: BasicTime.Update[x.when, diff],
to: x.to ]]],
UpdateReminders[rl.rest] ]];
ENDCASE => ERROR};
meeting.start ¬ newTime;
SELECT TRUE FROM
NOT remindersToo => NULL;
NOT newReminders => FOR rl: RemindList ¬ meeting.reminders, rl.rest WHILE rl#NIL DO
WITH rl.first SELECT FROM
x: AlertReminder => {
x.start ¬ BasicTime.Update[x.start, diff];
x.stop ¬ BasicTime.Update[x.stop, diff]};
x: MailReminder => {
x.when ¬ BasicTime.Update[x.when, diff]};
ENDCASE => ERROR;
ENDLOOP;
ENDCASE => meeting.reminders ¬ UpdateReminders[meeting.reminders];
RETURN};
CompactDb: PUBLIC PROC[dbName: ROPE ¬ NIL] = {
db: LoganBerry.OpenDB;
rt: RTable;
[db, rt, ] ¬ OpenDb[name: dbName];
IF db = LoganBerry.nullDB THEN RETURN;
LoganBerry.CompactLogs[db: db];
};
dbnToBadIntervals
: SymTab.Ref--usedDbName => badIntervals: RedBlackTree.Table--
~ SymTab.Create[case: TRUE];
No interval in a badIntervals is a sub-interval of another.
GetTable: PROC [usedDbName: ROPE] RETURNS [bads: RedBlackTree.Table ¬ NIL] ~ {
AddIfNeeded: PROC [found: BOOL, val: REF ANY] RETURNS [op: SymTab.UpdateOperation ¬ none, new: REF ANY ¬ NIL] ~ {
IF found
THEN {bads ¬ NARROW[val]; op ¬ none}
ELSE { new ¬ bads ¬ RedBlackTree.Create[GetIntervalKey, CompareIntervals]; op ¬ store}};
dbnToBadIntervals.Update[usedDbName, AddIfNeeded];
RETURN};
AssertBad: PROC [usedDbName: ROPE, i: REF RT.Range] ~ {
badIntervals: RedBlackTree.Table ~ GetTable[usedDbName];
--Assert: i.next = NIL-- badIntervals.Insert[i, i];
RETURN};
IntervalIsBad: PROC [usedDbName: ROPE, i: REF RT.Range] RETURNS [BOOL] ~ {
badIntervals: RedBlackTree.Table ~ GetTable[usedDbName];
data, eqData: REF ANY;
[, eqData, data] ¬ badIntervals.Lookup3[i];
IF eqData#NIL THEN RETURN [TRUE];
WHILE data#NIL DO
fr: REF RT.Range ~ NARROW[data];
IF fr.key1 > i.key2 THEN RETURN [FALSE];
IF fr.key2 <= i.key2 THEN RETURN [TRUE];
data ¬ badIntervals.LookupNextLarger[data];
ENDLOOP;
RETURN [FALSE]};
GetIntervalKey: PROC [data: REF ANY] RETURNS [REF ANY]
~ {RETURN [data]};
CompareIntervals: PROC [k, data: REF ANY] RETURNS [Basics.Comparison] ~ {
k1: REF RT.Range ~ NARROW[k];
k2: REF RT.Range ~ NARROW[data];
SELECT TRUE FROM
k1.key1<k2.key1 => RETURN [less];
k1.key1>k2.key1 => RETURN [greater];
k1.key2>k2.key2 => RETURN [less];
k1.key2<k2.key2 => RETURN [greater];
ENDCASE => RETURN [equal]};
CloseDb: PUBLIC PROC[dbName: ROPE ¬ NIL] = {
db: LoganBerry.OpenDB;
rt: RTable;
[db, rt, ] ¬ OpenDb[name: dbName];
IF db = LoganBerry.nullDB THEN RETURN;
CloseLoganBerry[db];
};
CloseLoganBerry: PROC[db: LoganBerry.OpenDB] = {
LoganBerryExtras.UnregisterWriteProc[db, $Remind];
LoganBerry.Close[db: db];
};
ChangeLoganBerryDbName: UserProfile.ProfileChangedProc = {
PROC [reason: UserProfile.ProfileChangeReason]
newDbName: ROPE ¬ UserProfile.Token["Remind.DbName", UserProfile.Token["Remind.DfFile", NIL]];
IF Rope.IsEmpty[newDbName] THEN
newDbName ¬ Rope.Concat[SystemNames.UserCedarDir[NIL], defaultName];
IF NOT Rope.Equal[s1: defaultDbName, s2: newDbName, case: FALSE] THEN {
IF (NOT Rope.IsEmpty[defaultDbName]) AND (defaultDbName.Find["@"] < 0) THEN {
db: LoganBerry.OpenDB ¬ OpenDb[name: defaultDbName].db;
IF db # LoganBerry.nullDB THEN {
LoganBerry.UnregisterWriteProc[db, $Remind];
LoganBerry.Close[db: db];
};
};
defaultDbName ¬ newDbName;
DatabaseChanged[LoganBerry.nullDB, NIL, NIL, NIL];
};
};
defaultDbName: ROPE ¬ NIL;
target: ROPE ¬ NIL;
defaultName: ROPE ¬ "CalendarBerry.df";
ProcBlockRec: TYPE = RECORD[
proc: PROC[data: REF],
dbName: ROPE, -- perhaps should instead have blocklist per database?
data: REF ANY,
ident: ATOM];
ProcBlock: TYPE = REF ProcBlockRec;
changeProcList: List.LORA ¬ NIL; -- LIST OF ProcBlock
Commander.Register["RemindImpl.TimeFromUnix", TimeFromUnixCmd, "<an integer> -- invokes RemindImpl.UnixToBasicTime"];
Commander.Register["RemindImpl.TimeFromInt", TimeFromIntCmd, "<an integer> -- invokes RemindImpl.TimeFromInt"];
Commander.Register["­GMT", GMTUpCmd, "<an integer> -- the abstraction function of the BasicTime.GMT representation scheme"];
UserProfile.CallWhenProfileChanges[ChangeLoganBerryDbName];
END.