2011-06-22 13:20:01 +00:00
|
|
|
"
|
|
|
|
(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 <http://www.gnu.org/licenses/>.
|
|
|
|
"
|
|
|
|
|
|
|
|
Object subclass: Timer [
|
|
|
|
| schedule timeout block |
|
|
|
|
|
|
|
|
<category: 'OSMO-Timer'>
|
|
|
|
<comment: 'This is a receipt for an active timer'>
|
|
|
|
|
|
|
|
Timer class >> on: aSchedule [
|
|
|
|
<category: 'creation'>
|
|
|
|
^ self new
|
|
|
|
schedule: aSchedule;
|
|
|
|
yourself
|
|
|
|
]
|
|
|
|
|
|
|
|
timeout [
|
|
|
|
<category: 'accessing'>
|
|
|
|
^ timeout
|
|
|
|
]
|
|
|
|
|
|
|
|
schedule: aSchedule [
|
|
|
|
<category: 'creation'>
|
|
|
|
schedule := aSchedule.
|
|
|
|
]
|
|
|
|
|
|
|
|
timeout: aTimeout [
|
|
|
|
<category: 'creation'>
|
|
|
|
timeout := aTimeout.
|
|
|
|
]
|
|
|
|
|
|
|
|
block: aBlock [
|
|
|
|
<category: 'creation'>
|
|
|
|
block := aBlock
|
|
|
|
]
|
|
|
|
|
|
|
|
fire [
|
|
|
|
<category: 'execution'>
|
|
|
|
block value
|
|
|
|
]
|
|
|
|
|
|
|
|
cancel [
|
|
|
|
<category: 'management'>
|
2011-07-06 14:56:09 +00:00
|
|
|
"Remember that the timer is gone."
|
|
|
|
schedule := nil.
|
|
|
|
]
|
|
|
|
|
|
|
|
isCanceled [
|
|
|
|
<category: 'management'>
|
|
|
|
^ schedule == nil.
|
2011-06-22 13:20:01 +00:00
|
|
|
]
|
|
|
|
]
|
|
|
|
|
|
|
|
Object subclass: TimerScheduler [
|
|
|
|
| queue sem loop quit |
|
|
|
|
<category: 'OSMO-Timer'>
|
|
|
|
<comment: 'I can help to fire things at the right time. Right now I
|
|
|
|
only work on seconds granularity because Time has no direct access to
|
|
|
|
milliseconds. Also I run a loop every second. I should use a Semaphore to
|
|
|
|
signal the process about a change of the closest time but it might be a
|
|
|
|
bit difficult to do this race free.'>
|
|
|
|
|
|
|
|
TimerScheduler class >> instance [
|
|
|
|
<category: 'singleton'>
|
|
|
|
^ Smalltalk at: #OsmoTimeScheduler ifAbsentPut: [TimerScheduler new].
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
|
|
TimerScheduler class >> new [
|
|
|
|
<category: 'private'>
|
|
|
|
^ super new
|
|
|
|
initialize;
|
|
|
|
addToBeFinalized;
|
|
|
|
yourself
|
|
|
|
]
|
|
|
|
|
|
|
|
finalize [
|
|
|
|
<category: 'private'>
|
|
|
|
quit := true.
|
|
|
|
]
|
|
|
|
|
|
|
|
initialize [
|
|
|
|
<category: 'private'>
|
|
|
|
queue := SortedCollection sortBlock: [:a :b | a timeout < b timeout].
|
|
|
|
sem := Semaphore forMutualExclusion.
|
|
|
|
quit := false.
|
|
|
|
loop := [self runTimers] fork.
|
|
|
|
]
|
|
|
|
|
|
|
|
scheduleInSeconds: aDelay block: aBlock [
|
|
|
|
| sched |
|
|
|
|
<category: 'schedule'>
|
|
|
|
sched := (Timer on: self)
|
|
|
|
block: aBlock;
|
|
|
|
timeout: (DateTime now + (Duration milliseconds: 1000 * aDelay));
|
|
|
|
yourself.
|
|
|
|
|
|
|
|
sem critical: [
|
|
|
|
queue add: sched.
|
|
|
|
].
|
|
|
|
|
|
|
|
^ sched
|
|
|
|
]
|
|
|
|
|
|
|
|
runTimers [
|
|
|
|
<category: 'delay_loop'>
|
|
|
|
|
|
|
|
[quit] whileFalse: [ | now |
|
|
|
|
|
|
|
|
(Delay forSeconds: 1) wait.
|
|
|
|
now := DateTime now.
|
2011-06-28 22:32:27 +00:00
|
|
|
OsmoDispatcher dispatchBlock: [self fireTimers: now].
|
2011-06-22 13:20:01 +00:00
|
|
|
]
|
|
|
|
]
|
|
|
|
|
|
|
|
fireTimers: now [
|
|
|
|
<category: 'private'>
|
|
|
|
|
|
|
|
"Now execute the timers. One way or another this is crazy. If we have
|
2011-06-28 09:54:27 +00:00
|
|
|
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."
|
2011-07-06 14:56:09 +00:00
|
|
|
"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 |
|
2011-06-28 22:32:27 +00:00
|
|
|
e logException: 'Execution of timer failed: %1' % {e tag} area: #timer.
|
2011-07-06 14:56:09 +00:00
|
|
|
]].
|
|
|
|
]
|
2011-06-22 13:20:01 +00:00
|
|
|
]
|
|
|
|
]
|
|
|
|
|