blob: a5d3e93a197203c259ffe2dda5b166c7fa54ee5a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
"
(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'>
"Remember that the timer is gone."
schedule := nil.
]
isCanceled [
<category: 'management'>
^ schedule == nil.
]
]
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.
OsmoDispatcher dispatchBlock: [self fireTimers: now].
]
]
fireTimers: now [
<category: 'private'>
"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: %1' % {e tag} area: #timer.
]].
]
]
]
|
