<<>> <> <> <> <> <> <> <> <> <> <<>> 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 <> <<>> = 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], " "]]; 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], " "]]; 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], " "]]; 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 { <> 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]; }; }; <> id ¬ IntFromTime[BasicTime.Now[]]; Link[$uniqID, Convert.RopeFromInt[id]]; <> 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>> <>> <<{IF ec = $DBClosed THEN {OpenLoganBerry[name: dbName]; RETRY} ELSE REJECT}>> <<];>> LoganBerry.WriteEntry[db: db, entry: entry]; <> 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}; <> 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 { <> 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]; <> 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; }; <> 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}; }; < 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]; <> 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; <> 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; <> 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; <> 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]; <> 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 RETURN [less]; k1.key1>k2.key1 => RETURN [greater]; k1.key2>k2.key2 => RETURN [less]; k1.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] = { <> LoganBerry.Close[db: db]; }; ChangeLoganBerryDbName: UserProfile.ProfileChangedProc = { <> 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, " -- invokes RemindImpl.UnixToBasicTime"]; Commander.Register["RemindImpl.TimeFromInt", TimeFromIntCmd, " -- invokes RemindImpl.TimeFromInt"]; Commander.Register["­GMT", GMTUpCmd, " -- the abstraction function of the BasicTime.GMT representation scheme"]; UserProfile.CallWhenProfileChanges[ChangeLoganBerryDbName]; END.