osmo-st-core/Timer.st

"
 (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 ifAbsent: [].
        ].
    ]

    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 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."
        copy do: [:each |
            each timeout > now ifTrue: [^true].
            sem critical: [queue remove: each].
            OsmoDispatcher dispatchBlock: [each fire].
        ].
    ]
]