timer: Add the initial version of the timer code
The code comes from the OsmoGSM repository but didn't have a lot of history.
This commit is contained in:
Holger Hans Peter Freyther
commit
4570878f9a
|
|
@ -0,0 +1 @@
|
|||
*.sw?
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
"
|
||||
(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/>.
|
||||
"
|
||||
|
||||
PackageLoader fileInPackage: #OsmoLogging.
|
||||
|
||||
Osmo.LogArea subclass: LogAreaTimer [
|
||||
LogAreaTimer class [
|
||||
areaName [ ^ #timer ]
|
||||
areaDescription [ ^ 'Timer related' ]
|
||||
default [
|
||||
^ self new
|
||||
enabled: true;
|
||||
minLevel: Osmo.LogLevel debug;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
"
|
||||
(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/>.
|
||||
"
|
||||
|
||||
TestCase subclass: TimerTest [
|
||||
<category: 'Very simple timer tests'>
|
||||
|
||||
testTimer [
|
||||
| sem now |
|
||||
now := DateTime now.
|
||||
sem := Semaphore new.
|
||||
TimerScheduler instance scheduleInSeconds: 2 block: [
|
||||
sem signal.
|
||||
].
|
||||
|
||||
sem wait.
|
||||
self assert: (DateTime now - now) asSeconds >= 2.
|
||||
]
|
||||
|
||||
testCancel [
|
||||
| timer1 timer2 fire1 sem block |
|
||||
sem := Semaphore new.
|
||||
block := [sem signal].
|
||||
|
||||
|
||||
fire1 := TimerScheduler instance scheduleInSeconds: 5 block: block.
|
||||
timer1 := TimerScheduler instance scheduleInSeconds: 3 block: block.
|
||||
timer2 := TimerScheduler instance scheduleInSeconds: 2 block: block.
|
||||
|
||||
timer2 cancel.
|
||||
timer1 cancel.
|
||||
|
||||
sem wait.
|
||||
self assert: sem signals = 0
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,154 @@
|
|||
"
|
||||
(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'>
|
||||
schedule removeTimer: self.
|
||||
]
|
||||
]
|
||||
|
||||
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
|
||||
]
|
||||
|
||||
removeTimer: aSched [
|
||||
<category: 'schedule'>
|
||||
sem critical: [
|
||||
queue remove: aSched.
|
||||
].
|
||||
]
|
||||
|
||||
runTimers [
|
||||
<category: 'delay_loop'>
|
||||
|
||||
[quit] whileFalse: [ | now |
|
||||
|
||||
(Delay forSeconds: 1) wait.
|
||||
now := DateTime now.
|
||||
self fireTimers: now.
|
||||
]
|
||||
]
|
||||
|
||||
fireTimers: now [
|
||||
<category: 'private'>
|
||||
| copy |
|
||||
|
||||
"Create a shallow copy of the data"
|
||||
copy := sem critical: [queue copy].
|
||||
|
||||
"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 be get
|
||||
stuck. But if we run things in a new process the order of the timers
|
||||
might get run in a different order."
|
||||
copy do: [:each |
|
||||
each timeout > now ifTrue: [^true].
|
||||
sem critical: [queue remove: each].
|
||||
[
|
||||
each fire.
|
||||
] on: Error do: [:e |
|
||||
e logException: 'Execution of timer failed: %1' % {e tag} area: #timer.
|
||||
]
|
||||
].
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
<package>
|
||||
<name>OsmoCore</name>
|
||||
<namespace>Osmo</namespace>
|
||||
<prereq>OsmoLogging</prereq>
|
||||
|
||||
<filein>LogArea.st</filein>
|
||||
<filein>Timer.st</filein>
|
||||
|
||||
<test>
|
||||
<sunit>Osmo.TimerTest</sunit>
|
||||
<filein>Tests.st</filein>
|
||||
</test>
|
||||
</package>
|
||||
Reference in New Issue