"
(C) 2011 by Holger Hans Peter Freyther
All Rights Reserved
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see .
"
Object subclass: Timer [
| schedule timeout block |
Timer class >> on: aSchedule [
^ self new
schedule: aSchedule;
yourself
]
timeout [
^ timeout
]
schedule: aSchedule [
schedule := aSchedule.
]
timeout: aTimeout [
timeout := aTimeout.
]
block: aBlock [
block := aBlock
]
fire [
block value
]
cancel [
"Remember that the timer is gone."
schedule := nil.
block := nil.
]
isCanceled [
^ schedule == nil.
]
]
Object subclass: TimerScheduler [
| queue sem loop quit processExited |
TimerScheduler class >> instance [
^ Smalltalk at: #OsmoTimeScheduler ifAbsentPut: [TimerScheduler new].
]
TimerScheduler class >> new [
^ super new
initialize;
addToBeFinalized;
yourself
]
finalize [
quit := true.
]
initialize [
queue := SortedCollection sortBlock: [:a :b | a timeout < b timeout].
sem := Semaphore forMutualExclusion.
quit := false.
self startLoop.
]
startLoop [
processExited := Semaphore new.
loop := [[Processor activeProcess name: 'Osmo Timers'.
self runTimers
] ensure: [processExited signal. loop := nil]] fork
]
scheduleInSeconds: aDelay block: aBlock [
| sched |
sched := (Timer on: self)
block: aBlock;
timeout: (DateTime now + (Duration milliseconds: 1000 * aDelay));
yourself.
sem critical: [
queue add: sched.
].
^ sched
]
runTimers [
[quit] whileFalse: [ | now |
(Delay forSeconds: 1) wait.
now := DateTime now.
OsmoDispatcher dispatchBlock: [self fireTimers: now].
]
]
fireTimers: now [
"Now execute the timers. One way or another this is crazy. If we have
a long blocking application or a deadlock the timer queue will get
stuck. But if we run this in a new process a later process might be run
before this process, changing the order of the timers."
"Only this process will remove items, this is why we can check isEmpty
without having the lock"
[queue isEmpty or: [queue first timeout > now]] whileFalse: [ | each |
each := sem critical: [queue removeFirst].
each isCanceled ifFalse: [
[each fire] on: Error do: [:e |
e logException:
('Execution of timer failed: ', e messageText) area: #timer.
]].
]
]
]