From 4570878f9a16f6f1c4e328ef9fbdaf4fb61b7af6 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <zecke@selfish.org>
Date: Wed, 22 Jun 2011 15:20:01 +0200
Subject: [PATCH] timer: Add the initial version of the timer code

The code comes from the OsmoGSM repository but didn't have a
lot of history.
---
 .gitignore  |   1 +
 LogArea.st  |  32 +++++++++++
 Tests.st    |  50 +++++++++++++++++
 Timer.st    | 154 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 package.xml |  13 +++++
 5 files changed, 250 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 LogArea.st
 create mode 100644 Tests.st
 create mode 100644 Timer.st
 create mode 100644 package.xml

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..45d62d8
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.sw?
diff --git a/LogArea.st b/LogArea.st
new file mode 100644
index 0000000..901fcf9
--- /dev/null
+++ b/LogArea.st
@@ -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
+        ]
+    ]
+]
diff --git a/Tests.st b/Tests.st
new file mode 100644
index 0000000..a32490f
--- /dev/null
+++ b/Tests.st
@@ -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
+    ]
+]
diff --git a/Timer.st b/Timer.st
new file mode 100644
index 0000000..cb5ee19
--- /dev/null
+++ b/Timer.st
@@ -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.
+            ]
+        ].
+    ]
+]
+
diff --git a/package.xml b/package.xml
new file mode 100644
index 0000000..f692c8b
--- /dev/null
+++ b/package.xml
@@ -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>