<> <> <> <<>> DIRECTORY BasicTime USING [ GMT, nullGMT, earliestGMT, Period], DB USING [ AttributeValue, AttributeValueList, Relship, RelshipSet, RelationSubset, NextRelship, ReleaseRelshipSet, Entity, Aborted, T2V, I2V, DeclareEntity, MarkTransaction, TransactionOf, V2B, GetF, NameOf, V2E, V2T, V2I, V2S], Hickory USING [ EventTuple, Event, EventSet, EventList, Error, RepetitionType, All, Reminders, ExpandRepetitions, Group, ProtectionType, Options, NoOptions, MergeLists, OrderEventList], HickoryCache USING [ FindNextOccurrence, MaintainCache, MaxCost, FindCachedEvent], HickoryGroup USING [ GetGroupEvents], HickorySupport USING [ StartTransaction, RestartTransaction, I2P, I2R, R2I, ReConvertRopes, GetNextOccurrence], HickoryStorage USING [ protData], Rope USING [ ROPE], RopeSets USING [ IsSetEmpty, IsValueInSet] ; HickoryQueryImpl: CEDAR MONITOR LOCKS HickoryStorage.protData IMPORTS DB, BasicTime, Hickory, HickorySupport, HickoryStorage, HickoryCache, HickoryGroup, RopeSets EXPORTS Hickory SHARES HickorySupport, HickoryCache, HickoryGroup = BEGIN OPEN Hickory, DB, HickoryStorage.protData; MinTime: PROCEDURE [ t1, t2: BasicTime.GMT] RETURNS [ min: BasicTime.GMT] = INLINE BEGIN IF BasicTime.Period[ t1, t2] >= 0 THEN RETURN[ t1] ELSE RETURN[ t2]; END; -- MinTime <> RestoreEvents: PUBLIC ENTRY PROCEDURE [ from, to: BasicTime.GMT, options: Options _ NoOptions, group: Group _ NIL, key: Event _ NIL] RETURNS [ evList: LIST OF EventTuple] = BEGIN <> <> <> <> <> <> <> <> <> <> <> <> ENABLE UNWIND => NULL; simpleEvl: EventList _ NIL; repeatedEvl: EventList _ NIL; eventsOfGroup: Hickory.EventSet; keyEnt: DB.Entity _ NIL; success: BOOLEAN _ FALSE; IF BasicTime.Period[ from, to] < 0 THEN ERROR Hickory.Error[ BadInterval, NIL] ELSE IF from = to THEN ERROR Hickory.Error[ NullInterval, NIL]; eventsOfGroup.Head _ NIL; eventsOfGroup.Tail _ NIL; evList _ NIL; IF key # NIL AND group = NIL THEN BEGIN found: BOOLEAN _ FALSE; [ found, evList] _ LookInEnteredEventsCache[ key, options, from, to]; IF found THEN RETURN[ evList]; END; WHILE NOT success DO ENABLE Aborted => { HickorySupport.RestartTransaction; success _ FALSE; LOOP }; HickorySupport.StartTransaction[]; IF key # NIL THEN BEGIN keyEnt _ DeclareEntity[ eventDomain, key, OldOnly]; IF keyEnt = NIL THEN ERROR Error[ NoSuchEvent, key]; END ELSE IF group # NIL THEN BEGIN eventsOfGroup _ HickoryGroup.GetGroupEvents[ group]; IF RopeSets.IsSetEmpty[ eventsOfGroup] THEN RETURN[ NIL]; -- empty group END; simpleEvl _ GetEvents[ from, to, options, eventsOfGroup, keyEnt, TRUE]; repeatedEvl _ GetEvents[ from, to, options, eventsOfGroup, keyEnt, FALSE]; MarkTransaction[ TransactionOf[ $Hickory]]; success _ TRUE; ENDLOOP; evList _ MergeLists[ simpleEvl, repeatedEvl]; RETURN[ evList]; END; --RestoreEvents LookInEnteredEventsCache: INTERNAL PROCEDURE [ key: Event, options: Options, from, to: BasicTime.GMT] RETURNS [ found: BOOLEAN, evl: EventList] = BEGIN l: EventList _ HickoryCache.FindCachedEvent[ key]; IF l = NIL THEN RETURN[ FALSE, NIL]; IF options[ Reminders] AND NOT l.first.Remind THEN RETURN[ TRUE, NIL]; IF NOT options[ All] AND l.first.Forgotten THEN RETURN[ TRUE, NIL]; IF NOT( BasicTime.Period[ from, l.first.EventTime] >= 0 AND BasicTime.Period[ l.first.EventTime, to] >= 0) THEN RETURN[ TRUE, NIL]; IF l.first.RepeatType = None OR NOT options[ ExpandRepetitions] THEN RETURN[ TRUE, l] ELSE BEGIN until: BasicTime.GMT _ MinTime[ to, l.first.RepeatUntil]; evl _ Expand[ l.first, until]; evl _ OrderEventList[ evl]; RETURN[ TRUE, evl]; END; END; -- LookInEnteredEventsCache BuildQueryConstraints: INTERNAL PROCEDURE [ simple: BOOLEAN, options: Options, from, to: BasicTime.GMT, evSet: Hickory.EventSet, keyEnt: Entity _ NIL] RETURNS [ avl: AttributeValueList _ NIL] = BEGIN <> OPEN eventRel; av: AttributeValue; forget: BOOLEAN _ NOT options[ All]; reminders: BOOLEAN _ options[ Reminders]; IF forget THEN BEGIN -- don't include forgotten events <> <> NULL; END; IF reminders THEN BEGIN -- include only events to be reminded <> <> NULL; END; IF simple THEN av _ [ Time, T2V[ LOOPHOLE[ from]], T2V[ LOOPHOLE[ to]]] ELSE av _ [ Time, T2V[ LOOPHOLE[ BasicTime.earliestGMT]], T2V[ LOOPHOLE[ to]]]; avl _ CONS[ av, avl]; IF simple THEN av _ [ RepeatType, I2V[ HickorySupport.R2I[ None]], I2V[ HickorySupport.R2I[ None]]] ELSE av _ [ attribute: RepeatType, lo: I2V[ HickorySupport.R2I[ Hourly]], hi: I2V[ HickorySupport.R2I[ Complicated]]]; avl _ CONS[ av, avl]; IF keyEnt # NIL THEN BEGIN av _ [ attribute: Key, lo: keyEnt, hi: keyEnt]; avl _ CONS[ av, avl]; END ELSE IF NOT RopeSets.IsSetEmpty[ evSet] THEN BEGIN -- it's a group query... <> headEnt, tailEnt: Entity; headEnt _ DeclareEntity[ eventDomain, evSet.Head.Value, OldOnly]; tailEnt _ DeclareEntity[ eventDomain, evSet.Tail.Value, OldOnly]; IF headEnt = NIL THEN ERROR Hickory.Error[ NoSuchEvent, evSet.Head.Value]; IF tailEnt = NIL THEN ERROR Hickory.Error[ NoSuchEvent, evSet.Tail.Value ]; av _ [ attribute: Key, lo: headEnt, hi: tailEnt]; avl _ CONS[ av, avl]; END; RETURN[ avl]; END; -- BuildQueryConstraints GetEvents: INTERNAL PROCEDURE [ from, to: BasicTime.GMT, options: Options, es: Hickory.EventSet, keyEnt: Entity, simple: BOOLEAN] RETURNS [ evl: EventList] = BEGIN <> OPEN eventRel; avl: AttributeValueList; relSet: RelshipSet; expand: BOOLEAN _ options[ ExpandRepetitions]; avl _ BuildQueryConstraints[ simple, options, from, to, es, keyEnt]; relSet _ RelationSubset[ Rel, avl]; IF simple THEN evl _ BuildSimpleEventList[ relSet, options, es] ELSE evl _ BuildRepeatedEventList[ relSet, from, to, options, es]; ReleaseRelshipSet[ relSet]; IF NOT simple THEN BEGIN -- for repeated events evl _ OrderEventList[ evl]; -- must reorder on EventTime IF expand THEN evl _ ExpandRepeatedEventList[ evl, to]; END; END; -- GetEvents BuildSimpleEventList: INTERNAL PROCEDURE [ relSet: RelshipSet, options: Options, es: Hickory.EventSet] RETURNS [ evList: LIST OF EventTuple] = BEGIN <> << = None...>> OPEN eventRel; key: Event; msg, txt, pl, iconFlav, iconLab: Rope.ROPE; prot: Hickory.ProtectionType; tuple: Relship; ev: EventTuple; head, tail, new: EventList; reminders: BOOLEAN _ options[ Reminders]; forget: BOOLEAN _ NOT options[ All]; head _ NIL; tail _ NIL; new _ NIL; WHILE ( tuple _ NextRelship[ relSet]) # NIL DO forgotten: BOOLEAN _ V2B[ GetF[ tuple, Forgotten]]; reminder: BOOLEAN _ V2B[ GetF[ tuple, Reminder]]; IF forget AND forgotten THEN LOOP; IF NOT reminder AND reminders THEN LOOP; key _ NameOf[ V2E[ GetF[ tuple, Key]]]; IF NOT RopeSets.IsSetEmpty[ es] AND NOT RopeSets.IsValueInSet[ key, es] THEN LOOP; [ iconFlav, iconLab] _ QueryIcons[ V2E[ GetF[ tuple, Icon]]]; prot _ HickorySupport.I2P[ V2I[ GetF[ tuple, Protection]]]; IF prot = Private AND NOT owner THEN BEGIN msg _ ""; txt _ ""; pl _ ""; END ELSE BEGIN msg _ NameOf[ V2E[ GetF[ tuple, Message]]]; txt _ NameOf[ V2E[ GetF[ tuple, Text]]]; pl _ NameOf[ V2E[ GetF[ tuple, Place]]]; END; ev _ [ Key: key, EventTime: LOOPHOLE[ V2T[ GetF[ tuple, Time]]], Duration: V2I[ GetF[ tuple, Duration]], RepeatType: None, RepeatTime: NIL, RepeatUntil: BasicTime.nullGMT, KeepUntil: LOOPHOLE[ V2T[ GetF[ tuple, KeepTime]]], LeadTime: V2I[ GetF[ tuple, LeadTime]], NagTime: V2I[ GetF[ tuple, NagTime]], IconFlavor: iconFlav, IconLabel: iconLab, Message: msg, Text: txt, Place: pl, Protection: prot, Forgotten: forgotten, Remind: reminder]; ev _ HickorySupport.ReConvertRopes[ ev]; -- "" -> NIL! new _ CONS[ ev, NIL]; IF head = NIL THEN BEGIN -- pretty painful to keep things ordered head _ new; tail _ head; END ELSE BEGIN tail.rest _ new; tail _ new; END; ENDLOOP; <> head _ OrderEventList[ head]; -- this should not be needed if DB returned things ordered! RETURN[ head]; END; -- BuildSimpleEventList BuildRepeatedEventList: INTERNAL PROCEDURE [ relSet: RelshipSet, from, to: BasicTime.GMT, options: Options, es: Hickory.EventSet] RETURNS [ evList: EventList] = BEGIN <> <> OPEN eventRel; key: Event; msg, txt, pl, iconFlav, iconLab, repTime: Rope.ROPE; prot: Hickory.ProtectionType; tuple: Relship; ev: EventTuple; evEnt: Entity; lastTime, firstTime, next, repeatUntil: BasicTime.GMT; repType: RepetitionType; forget: BOOLEAN _ NOT options[ All]; reminders: BOOLEAN _ options[ Reminders]; evList _ NIL; -- relSet contains ALL repeated events, even the forgotten ones for now! WHILE ( tuple _ NextRelship[ relSet]) # NIL DO forgotten: BOOLEAN _ V2B[ GetF[ tuple, Forgotten]]; reminder: BOOLEAN _ V2B[ GetF[ tuple, Reminder]]; IF forget AND forgotten THEN LOOP; IF NOT reminder AND reminders THEN LOOP; evEnt _ V2E[ GetF[ tuple, Key]]; [ firstTime, lastTime, repType, repTime, repeatUntil] _ GetRepeatPars[ evEnt]; IF BasicTime.Period[ from, repeatUntil] >= 0 THEN BEGIN <> key _ NameOf[ evEnt]; IF NOT RopeSets.IsSetEmpty[ es] AND NOT RopeSets.IsValueInSet[ key, es] THEN LOOP; <> <> next _ HickoryCache.FindNextOccurrence[ key, firstTime, lastTime, from, repType, repTime]; <= from...>> IF BasicTime.Period[ to, next] <= 0 THEN BEGIN -- there is occurrence in interval... [ iconFlav, iconLab] _ QueryIcons[ V2E[ GetF[ tuple, Icon]]]; prot _ HickorySupport.I2P[ V2I[ GetF[ tuple, Protection]]]; IF prot = Private AND NOT owner THEN BEGIN msg _ ""; txt _ ""; pl _ ""; END ELSE BEGIN msg _ NameOf[ V2E[ GetF[ tuple, Message]]]; txt _ NameOf[ V2E[ GetF[ tuple, Text]]]; pl _ NameOf[ V2E[ GetF[ tuple, Place]]]; END; ev _ [ Key: key, EventTime: next, Duration: V2I[ GetF[ tuple, Duration]], RepeatType: repType, RepeatTime: repTime, RepeatUntil: repeatUntil, KeepUntil: LOOPHOLE[ V2T[ GetF[ tuple, KeepTime]]], LeadTime: V2I[ GetF[ tuple, LeadTime]], NagTime: V2I[ GetF[ tuple, NagTime]], IconFlavor: iconFlav, IconLabel: iconLab, Message: msg, Text: txt, Place: pl, Protection: prot, Remind: reminder, Forgotten: forgotten]; ev _ HickorySupport.ReConvertRopes[ ev]; evList _ CONS[ ev, evList]; -- order within list not relevant here END; -- if next > to... END; -- if repeatUntil < from... ENDLOOP; RETURN[ evList]; END; -- BuildRepeatedEventList GetRepeatPars: INTERNAL PROCEDURE [ evEnt: Entity] RETURNS [ firstTime, lastTime: BasicTime.GMT, repType: RepetitionType, repTime: Rope.ROPE, repUntil: BasicTime.GMT] = BEGIN <> OPEN repeatRel; relSet: RelshipSet; tuple: Relship; av: AttributeValue; av _ [ Event, evEnt, evEnt]; relSet _ RelationSubset[ Rel, LIST[ av]]; tuple _ NextRelship[ relSet]; IF tuple = NIL THEN ERROR; firstTime _ LOOPHOLE[ V2T[ GetF[ tuple, FirstTime]]]; lastTime _ LOOPHOLE[ V2T[ GetF[ tuple, LastOccurred]]]; repTime _ NameOf[ V2E[ GetF[ tuple, RepeatTime]]]; repType _ HickorySupport.I2R[ V2I[ GetF[ tuple, RepeatType]]]; repUntil _ LOOPHOLE[ V2T[ GetF[ tuple, RepeatUntil]]]; IF NextRelship[ relSet] # NIL THEN ERROR; ReleaseRelshipSet[ relSet]; RETURN[ firstTime, lastTime, repType, repTime, repUntil]; END; -- GetRepeatPar ExpandRepeatedEventList: INTERNAL PROCEDURE [ evl: EventList, to: BasicTime.GMT] RETURNS [ newList: EventList] = BEGIN <> tempList: EventList; newList _ NIL; FOR l: EventList _ evl, l.rest UNTIL l = NIL DO tempList _ Expand[ l.first, to]; newList _ MergeLists[ newList, tempList]; ENDLOOP; RETURN[ newList]; END; -- ExpandRepeatedEventList Expand: INTERNAL PROCEDURE[ ev: EventTuple, to: BasicTime.GMT] RETURNS [ evl: EventList] = BEGIN <> <> <> tail, new: EventList; nextTime: BasicTime.GMT; cost: CARDINAL _ 0; evl _ CONS[ ev, NIL]; tail _ evl; DO -- ..EventTime is for sure in time interval of query nextTime _ HickorySupport.GetNextOccurrence[ LOOPHOLE[ tail.first.EventTime], tail.first.RepeatType, tail.first.RepeatTime]; IF cost >= HickoryCache.MaxCost THEN BEGIN HickoryCache.MaintainCache[ ev.Key, nextTime]; cost _ 0; END ELSE cost _ cost + 1; IF BasicTime.Period[ to, nextTime] > 0 THEN EXIT; IF BasicTime.Period[ ev.RepeatUntil, nextTime] > 0 THEN EXIT; new _ CONS[ tail.first, NIL]; new.first.EventTime _ nextTime; tail.rest _ new; tail _ new; ENDLOOP; RETURN[ evl]; END; -- Expand QueryIcons: INTERNAL PROCEDURE [ key: Entity] RETURNS [ iconFlav, iconLab: Rope.ROPE] = BEGIN <> OPEN iconRel; av: AttributeValue; relSet: RelshipSet; tuple: Relship; av _ [ Key, key, key]; relSet _ RelationSubset[ Rel, LIST[ av]]; tuple _ NextRelship[ relSet]; IF tuple = NIL THEN RETURN[ "", ""]; iconFlav _ V2S[ GetF[ tuple, IconFlavor]]; iconLab _ V2S[ GetF[ tuple, IconLabel]]; ReleaseRelshipSet[ relSet]; RETURN[ iconFlav, iconLab]; END; -- QueryIcons END.