rise from the dead

.gitignore

@@ -0,0 +1,2 @@
+*~
+*.fasl

COPYING

@@ -0,0 +1,28 @@
+Clon, a Common Lisp library for scheduling.
+
+Copyright (c) 2007 Gábor Melis
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+  * Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+  * Redistributions in binary form must reproduce the above
+    copyright notice, this list of conditions and the following
+    disclaimer in the documentation and/or other materials
+    provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

ChangeLog

@@ -0,0 +1,19 @@
+2007-01-23  Gabor Melis  <mega@retes.hu>
+
+	* released v0.0.1
+
+2007-01-19  Gabor Melis  <mega@retes.hu>
+
+	* doc/example.lisp: more examples
+
+	* clon.lisp (make-typed-cron-schedule): added convenience function
+	to allow terser syntax
+
+2007-01-18  Gabor Melis  <mega@retes.hu>
+
+	* doc/example.lisp: added
+
+	* barrier.lisp: removed
+
+	* renamed to clon from chronic that was taken
+

README

@@ -0,0 +1,16 @@
+Clon is a Common Lisp library for scheduling much like cron.
+
+It's under the MIT licence. See COPYING.
+
+How to use it:
+
+;;; create a stateless schedule:
+(make-typed-cron-schedule :second '(member 0 10 20 30 40 50))
+;;; create a scheduler that remembers the last scheduled time:
+(make-scheduler *)
+;;; schedule a function:
+(schedule-function (lambda ()
+                    (print (get-universal-time)))
+                   *)
+;;; unschedule the timer returned by SCHEDULE-FUNCTION:
+(trivial-timers:unschedule-timer *)

TODO

@@ -0,0 +1,11 @@
+# -*- mode: org -*-
+#+TODO: MAYBE(m@) LOG(l@) DEFERRED(f@)
+#+SEQ_TODO: TODO(t@) NEXT(n@) STARTED(s@) WAITING(w@) | DONE(d@) CANCELLED(c@)
+#+STARTUP: hidestars
+* DONE make it portable
+  CLOSED: [2008-12-12 Fri 10:39]
+  Use trivial-timers and bordeaux-threads. Patch by Clinton Ebadi
+  <clinton@unknownlamer.org>.
+* to support time zones we need better time handling than what
+   available in pure Common Lisp.
+* maybe a cron syntax converter: "0-30" => (integer 0 30)

clon-test.asd

@@ -0,0 +1,12 @@
+;;;; -*- Mode: Lisp -*-
+
+(cl:defpackage #:clon-test-system
+  (:use #:asdf #:cl))
+
+(cl:in-package #:clon-test-system)
+
+(defsystem :clon-test
+  :depends-on (#:clon)
+  :components ((:file "test-packages")
+               (:file "clon-test"))
+  :serial t)

clon-test.lisp

@@ -0,0 +1,78 @@
+(in-package :clon-test)
+
+(defmacro assert-error (&body body)
+  `(assert (nth-value 1 (ignore-errors (progn ,@body)))))
+
+(defun test-next-time ()
+  (let ((now '(15 30 3 23 5 1974)))
+    (flet ((foo (spec result &key (now now) allow)
+             (let ((r (next-time spec
+                                 :allow-now-p allow
+                                 :now (clon::encode-universal-time* now))))
+               (assert (or (and (null r) (null result))
+                           (equal result
+                                  (subseq (clon::decode-universal-time* r)
+                                          0 6)))))))
+      (assert-error (foo (make-cron-schedule) '(15 30 3 23 5 1974)))
+      (foo (make-cron-schedule :second 14) '(14 31 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :second 15) '(15 30 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :second 15) '(15 31 3 23 5 1974))
+      (foo (make-cron-schedule :second 16) '(16 30 3 23 5 1974))
+      (foo (make-cron-schedule :minute 29) '(0 29 4 23 5 1974) :allow t)
+      (foo (make-cron-schedule :minute 30) '(15 30 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :minute 30) '(0 30 4 23 5 1974))
+      (foo (make-cron-schedule :minute 31) '(0 31 3 23 5 1974))
+      (foo (make-cron-schedule :hour 2) '(0 0 2 24 5 1974) :allow t)
+      (foo (make-cron-schedule :hour 3) '(15 30 3 23 5 1974)  :allow t)
+      (foo (make-cron-schedule :hour 3) '(0 0 3 24 5 1974))
+      (foo (make-cron-schedule :hour 4) '(0 0 4 23 5 1974))
+      (foo (make-cron-schedule :day-of-month 22) '(0 0 0 22 6 1974) :allow t)
+      (foo (make-cron-schedule :day-of-month 23) '(15 30 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :day-of-month 23) '(0 0 0 23 6 1974))
+      (foo (make-cron-schedule :day-of-month 24) '(0 0 0 24 5 1974))
+      (foo (make-cron-schedule :month 4) '(0 0 0 1 4 1975) :allow t)
+      (foo (make-cron-schedule :month 5) '(15 30 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :month 5) '(0 0 0 1 5 1975))
+      (foo (make-cron-schedule :month 6) '(0 0 0 1 6 1974))
+      (foo (make-cron-schedule :year 1973) nil :allow t)
+      (foo (make-cron-schedule :year 1974) '(15 30 3 23 5 1974) :allow t)
+      (foo (make-cron-schedule :year 1974) nil)
+      (foo (make-cron-schedule :year 1975) '(0 0 0 1 1 1975))
+      (foo (make-cron-schedule :day-of-month 1 :month 5) '(0 0 0 1 5 1975))
+      ;; Test limit
+      (foo (make-cron-schedule :year 40000) nil)
+      ;; Hour 3 -> hour 2 -> hour overflow -> day overflow -> month
+      ;; overflow -> year overflow.
+      (foo (make-cron-schedule :hour 2 :month 5) '(0 0 2 1 5 1975)
+           :now '(15 30 3 31 5 1974))
+      ;; Maximum overflow.
+      (foo (make-cron-schedule :second 0) '(0 0 0 1 1 1975)
+           :now '(1 59 23 31 12 1974))
+      ;; Thursday -> Saturday
+      (foo (make-cron-schedule :day-of-week 5) '(0 0 0 25 5 1974))
+      ;; Thursday -> Wednesday
+      (foo (make-cron-schedule :day-of-week 2) '(0 0 0 29 5 1974))
+      ;; February doesn't have 31 days.
+      (foo (make-cron-schedule :day-of-month 31) '(0 0 0 31 3 1974)
+           :now '(15 30 3 20 2 1974))
+      ;; So this never happens:
+      (foo (make-cron-schedule :day-of-month 31 :month 2) nil)
+      ;; Simple function bumpers.
+      (foo (make-cron-schedule :second (constantly 15)) '(15 30 3 23 5 1974)
+           :allow t)
+      (foo (make-cron-schedule :second (constantly 19)) '(19 30 3 23 5 1974)
+           :allow t)
+      (foo (make-cron-schedule :second (constantly 10)) '(10 31 3 23 5 1974)
+           :allow t)
+      ;; Hairy typed bumpers.
+      (let ((hairy (make-cron-schedule
+                    :second (make-typed-cron-bumper '(member 0 15 30 45))
+                    :minute (make-typed-cron-bumper '(and (integer 10 40)
+                                                      (satisfies evenp))))))
+        (foo hairy '(15 30 3 31 5 1974) :now '(15 30 3 31 5 1974) :allow t)
+        (foo hairy '(30 30 3 31 5 1974) :now '(15 30 3 31 5 1974))
+        (foo hairy '(15 30 3 31 5 1974) :now '(13 30 3 31 5 1974))
+        (foo hairy '(0 32 3 31 5 1974) :now '(48 30 3 31 5 1974))))))
+
+(defun test-clon ()
+  (test-next-time))

clon.asd

@@ -0,0 +1,15 @@
+;;;; -*- Mode: Lisp -*-
+
+(cl:defpackage #:clon-system
+  (:use :cl :asdf))
+
+(cl:in-package #:clon-system)
+
+(defsystem :clon
+  :name "Clon"
+  :author "Gábor Melis <mega@retes.hu>"
+  :version "0.0.2"
+  :components ((:file "packages")
+               (:file "clon"))
+  :serial t
+  :depends-on (:bordeaux-threads :trivial-timers))

clon.lisp

@@ -0,0 +1,320 @@
+(in-package :clon)
+
+;;;; Generic interface
+
+(defparameter *default-next-time-limit*
+  (encode-universal-time 0 0 0 1 1 3000)
+  "The default time limit for NEXT-TIME searches.")
+
+(defgeneric next-time (schedule &key now allow-now-p limit)
+  (:documentation "Return the next time according to SCHEDULE or NIL
+if there is no next time. If ALLOW-NOW-P the earliest possible time to
+be returned is NOW, else it is usually NOW + the resolution of the
+schedule. The default value of NOW is (GET-UNIVERSAL-TIME),
+ALLOW-NOW-P is NIL and LIMIT is *DEFAULT-NEXT-TIME-LIMIT*"))
+
+(defun make-scheduler (schedule &key (now (get-universal-time))
+                       allow-now-p (limit *default-next-time-limit*))
+  "Return a `scheduler' function of no arguments that returns times
+from NOW on by repeatedly calling NEXT-TIME on SCHEDULE. ALLOW-NOW-P
+is passed to the first invocation of NEXT-TIME."
+  (lambda ()
+    (prog1
+        (setf now (next-time schedule :now now :allow-now-p allow-now-p
+                             :limit limit))
+      (setf allow-now-p nil))))
+
+(defun schedule-function (function scheduler &key name
+                          (thread (bt:current-thread)))
+  "Create a timer just as with TRIVIAL-TIMERS:MAKE-TIMER but schedule
+and reschedule FUNCTION according to SCHEDULER that is a function of
+no parameters that returns a universal time or NIL. The returned timer
+can be shut down with TRIVIAL-TIMERS:UNSCHEDULE-TIMER."
+  (let (timer)
+    (flet ((foo ()
+             (let ((next-time (funcall scheduler)))
+               (when next-time
+                 (trivial-timers:schedule-timer timer next-time
+                                                :absolute-p t)))
+             (funcall function)))
+      (setf timer
+            (trivial-timers:make-timer #'foo
+                                       :name name
+                                       :thread thread)))
+    (let ((first-time (funcall scheduler)))
+      (when first-time
+        (trivial-timers:schedule-timer timer first-time :absolute-p t)))
+    timer))
+
+
+;;;; Time utilities
+
+;;; From sbcl's time.lisp
+#-sbcl
+(defun leap-years-before (year)
+  (let ((years (- year 1901)))
+    (+ (- (truncate years 4)
+	  (truncate years 100))
+       (truncate (+ years 300) 400))))
+
+(defun decode-universal-time* (time)
+  "Return the decoded time components as a list instead of multiple
+values."
+  (multiple-value-list (decode-universal-time time)))
+
+(defun encode-universal-time* (decoded-time)
+  "Encode DECODED-TIME that is a decoded time in list form such as one
+that was returned by DECODE-UNIVERSAL-TIME*."
+  (apply #'encode-universal-time (subseq decoded-time 0 6)))
+
+(defun days-of-month (decoded-time)
+  "Return the number of days in the month DECODED-TIME."
+  (let ((year (elt decoded-time 5))
+        (month (elt decoded-time 4)))
+    (+ (aref #(31 28 31 30 31 30 31 31 30 31 30 31) (1- month))
+       (if (= 2 month)
+           (- (leap-years-before (1+ year))
+              (leap-years-before year))
+           0))))
+
+(defun min-valid-decoded-time-component (n)
+  "Return the smallest valid value for the Nth decoded time component."
+  (if (or (= n 3) (= n 4))
+      1
+      0))
+
+(defun max-valid-decoded-time-component (n &optional decoded-time)
+  "Return the largest valid value for the Nth component of
+DECODED-TIME or NIL if there is no limit. Passing DECODED-TIME is
+necessary only for the day of month component because the number of
+days in a month varies."
+  (ecase n
+    ;; second and minute
+    ((0 1) 59)
+    ;; hour
+    ((2) 23)
+    ;; day of month
+    ((3) (days-of-month decoded-time))
+    ;; month
+    ((4) 12)
+    ;; year
+    ((5) nil)
+    ;; day of week
+    ((6) 6)))
+
+(defun valid-decoded-time-compenent-p (n value)
+  "See if value can ever be a valid value as the Nth component of a
+decoded time."
+  (and (<= (min-valid-decoded-time-component n) value)
+       (let ((limit (max-valid-decoded-time-component n '(0 0 0 1 1 2000))))
+         (or (null limit) (<= value limit)))))
+
+(defun zero-decoded-time-below (decoded-time n)
+  "Set the first N components of DECODED-TIME to their
+MIN-VALID-DECODED-TIME-COMPONENT values."
+  (loop for i below n
+        do (setf (elt decoded-time i)
+                 (min-valid-decoded-time-component i))))
+
+(defun bump-decoded-time (time n &optional (m 1))
+  "Increment the Nth component of decoded TIME, handle overflows, zero
+the lower components. Return changed decoded time and the highest index
+that was changed."
+  (let ((max n))
+    (labels ((bump (time n)
+               (setf max (max max n))
+               (let ((limit (max-valid-decoded-time-component n time)))
+                 (cond ((or (null limit) (< (elt time n) limit))
+                        (incf (elt time n)))
+                       (t
+                        (setf (elt time n)
+                              (min-valid-decoded-time-component n))
+                        (bump time (1+ n)))))))
+      (loop repeat m do (bump time n))
+      (zero-decoded-time-below time max)
+      (values time max))))
+
+
+;;;; Cron-like schedule
+
+(defun next-bump (bumper decoded-time n)
+  "Invoke BUMPER on the Nth component of DECODED-TIME. Return its
+value if it can ever be valid (not necessarily in the context of
+DECODED-TIME) or else NIL."
+  (let* ((original (elt decoded-time n))
+         (next (cond ((null bumper) original)
+                     ((eql bumper '*) original)
+                     ((numberp bumper) bumper)
+                     (t (funcall bumper original decoded-time n)))))
+    (when (and next (not (valid-decoded-time-compenent-p n next)))
+      (error "Invalid value ~S for decoded time component ~S." next n))
+    (if (or (null next)
+            (< next original)
+            (and (= n 3)
+                 (< (days-of-month decoded-time) next)))
+        nil
+        next)))
+
+(defun bump-day-of-month-and-day-of-week (dom-bumper dow-bumper decoded-time)
+  "Extra hair due to the circular dependency between DAY-OF-MONTH and
+DAY-OF-WEEK bumpers. This function rolls the two bumpers into one."
+  ;; First let DOM-BUMPER decide what's NEXT. If it is NIL we're done.
+  ;; Else ask DOW-BUMPER what it thinks. If he likes it (i.e. returns
+  ;; the same day of week) then NEXT is the result. Else skip to the
+  ;; day of week it said or next Monday for NIL if it is still in the
+  ;; same month. Repeat.
+  (let* ((decoded-time (copy-list decoded-time))
+         (last-day-of-month (days-of-month decoded-time)))
+    (flet ((skip-days (n)
+             (incf (elt decoded-time 3) n)
+             ;; Keep DECODED-TIME consistent, update DAY-OF-WEEK.
+             (setf (elt decoded-time 6) (mod (+ (elt decoded-time 6) n) 7))))
+      (loop while (<= (elt decoded-time 3) last-day-of-month) do
+            (let* ((current-dom (elt decoded-time 3))
+                   (next-dom (next-bump dom-bumper decoded-time 3)))
+              (unless next-dom
+                (return nil))
+              (skip-days (- next-dom current-dom))
+              (assert (<= next-dom last-day-of-month)))
+            (let* ((current-dow (elt decoded-time 6))
+                   (next-dow (next-bump dow-bumper decoded-time 6)))
+              ;; See if the dom is also a blessed dow.
+              (when (eql next-dow current-dow)
+                (return (elt decoded-time 3)))
+              ;; Skip until the prescribed day or next Monday.
+              (skip-days (- (or next-dow 7) current-dow)))))))
+
+(defclass cron-schedule ()
+  ((bumpers :initarg :bumpers :reader bumpers
+            :documentation "The bumpers in decoded time component order."))
+  (:documentation "A cron-like schedule. See MAKE-CRON-SCHEDULE for details."))
+
+(defun make-cron-schedule (&key second minute hour day-of-month
+                           month year day-of-week)
+  "Construct a cron-like scheduler from the SECOND, MINUTE, etc
+bumpers for components of decoded times (using the default time zone
+for the time being). A bumper in its most generic from a function of
+three arguments: the current value, the whole decoded time, and the
+index of the current value in the decoded time. A bumper is expected
+to return the smallest value that is valid for that component and not
+less than the current value or NIL if it cannot find a valid value.
+Returning a value that is smaller than the current one is the same as
+returning NIL. A bumper can simply be a number which is equivalent to
+\(CONSTANTLY NUMBER).
+
+Bumpers are not allowed to depend on `lower' components of the decoded
+time. The allowed dependency graph is this:
+
+SECOND -> MINUTE -> HOUR -> (DAY-OF-MONTH <-> DAY-OF-WEEK) -> MONTH -> YEAR
+
+That is, the SECOND bumper may look at the whole decoded time but the
+MINUTE bumper may not look at seconds. DAY-OF-WEEK and DAY-OF-MONTH
+may depend on each other to allow specifying the 'last Friday of the
+month'.
+
+The resolution of the schedule is defined implicitly by the lowest
+bumper. NEXT-TIME always bumps the component of the decoded time that
+belongs to the lowest bumper before trying to find mathces if its
+LAST-TIME argument is not NIL. Of course, DAY-OF-WEEK is the odd one
+out: it is the day-of-month component that is bumped if DAY-OF-WEEK is
+the lowest bumper.
+
+This scheme allows (MAKE-CRON-SCHEDULE :MONTH 12) trigger only once
+per year instead of every second in December. For a more packed
+schedule one can use the symbol '* as a bumper: (MAKE-CRON-SCHEDULE
+:HOUR '* :MONTH 12) which makes hour the lowest bumper and the
+schedule triggers every hour in December.
+
+It is an error if all bumpers are NIL."
+  (let ((bumpers (list second minute hour day-of-month month year day-of-week)))
+    (unless (some #'identity bumpers)
+      (error "Cannot determine resolution of an empty schedule."))
+    (make-instance 'cron-schedule :bumpers bumpers)))
+
+(defun bumper-index->component-index (i)
+  "Return the index of the decoded time component that is effect by
+bumper I. Day of week is lumped together with day of month."
+  (if (= i 6) 3 i))
+
+(defun lowest-component-index-with-a-bumper (bumpers)
+  "Return the the index of what is basically the root of current
+dependency graph."
+  (loop for i upfrom 0
+        for bumper in bumpers
+        when bumper
+        minimize (bumper-index->component-index i)))
+
+(defun bump-lowest-component (bumpers time)
+  "Bump the lowest component of decoded TIME that has a bumper. Return
+it as a universal time."
+  (let ((decoded-time (decode-universal-time* time)))
+    (encode-universal-time*
+     (bump-decoded-time decoded-time
+                        (lowest-component-index-with-a-bumper
+                         bumpers)))))
+
+(defmethod next-time ((schedule cron-schedule) &key (now (get-universal-time))
+                      allow-now-p (limit *default-next-time-limit*))
+  (let ((bumpers (bumpers schedule)))
+    (unless allow-now-p
+      (setf now (bump-lowest-component bumpers now)))
+    (loop while (< now limit)
+          with n = 5
+          for decoded-time = (decode-universal-time* now)
+          for next = (if (= n 3)
+                         (bump-day-of-month-and-day-of-week (elt bumpers 3)
+                                                            (elt bumpers 6)
+                                                            decoded-time)
+                         (next-bump (elt bumpers n) decoded-time n))
+          do
+          (cond ((null next)
+                 (when (= n 5)
+                   ;; The desired year is in the past, there is no next
+                   ;; time.
+                   (return nil))
+                 ;; No valid value for this component, bump the next one
+                 ;; and come again.
+                 (multiple-value-setq (decoded-time n)
+                   (bump-decoded-time decoded-time (1+ n))))
+                (t
+                 (when (< (elt decoded-time n) next)
+                   (setf (elt decoded-time n) next)
+                   (zero-decoded-time-below decoded-time n))
+                 (decf n)))
+          (setf now (encode-universal-time* decoded-time))
+          (when (minusp n)
+            (return now)))))
+
+
+;;;; The convenience case: typed cron schedule
+
+(defun find-decoded-time-component-by-type (type value decoded-time n)
+  "Return the first valid value not less than VALUE that is of TYPE."
+  (loop with limit = (max-valid-decoded-time-component n decoded-time)
+        for x upfrom value below limit
+        do (when (typep x type)
+             (return-from find-decoded-time-component-by-type x))))
+
+(defun make-typed-cron-bumper (type)
+  "Return a bumper function suitable for MAKE-CRON-SCHEDULE that
+returns the first valid value according to TYPE. Convenience function
+on top of FIND-DECODED-TIME-COMPONENT-BY-TYPE."
+  (lambda (value decoded-time n)
+    (find-decoded-time-component-by-type type value decoded-time n)))
+
+(defun make-typed-cron-schedule (&key second minute hour day-of-month
+                                 month year day-of-week)
+  "A convenience function much like MAKE-CRON-SCHEDULE but assumes
+that no bumper can be a function designator so it must be a number,
+the symbol * or a type specifier in which case it calls
+MAKE-TYPED-CRON-BUMPER on it providing a terser syntax."
+  (flet ((convert-bumper (bumper)
+           (if (or (null bumper)
+                   (typep bumper 'number)
+                   (eq bumper '*))
+               bumper
+               (make-typed-cron-bumper bumper))))
+    (let ((bumpers (list second minute hour day-of-month month year
+                         day-of-week)))
+      (make-instance 'cron-schedule
+                     :bumpers (mapcar #'convert-bumper bumpers)))))

doc/example.lisp

@@ -0,0 +1,61 @@
+(in-package :cl-user)
+
+;;; If this runs under SLIME you may have to look into the
+;;; *inferior-lisp* buffer to see the output depending on your setup.
+(let ((n 0))
+  (defun say-hello ()
+    (incf n)
+    (format t "Hello world ~D at ~S~%" n
+            (multiple-value-list (decode-universal-time (get-universal-time))))
+    (force-output)))
+
+;;; SCHEDULE is not mutated by iterating over it by NEXT-TIME. A
+;;; SCHEDULER on the other hand is all about remembering the last
+;;; time. The schedule here reads as: 'seconds 0, 15, 30 and 45 of
+;;; every even minute that's between 10 and 40'.
+(let ((schedule (clon:make-typed-cron-schedule
+                 :second '(member 0 15 30 45)
+                 :minute '(and (integer 10 40) (satisfies evenp)))))
+  (clon:schedule-function 'say-hello
+                          (clon:make-scheduler schedule)
+                          :name "Hello world 1"
+                          :thread t))
+
+;;; SCHEDULE-FUNCTION returned a timer, stop it when we got bored of it.
+(sb-ext:unschedule-timer *)
+
+;;; Do something even more simple: say hello once every minute. Note
+;;; that the first one will happen immediately (thanks to ALLOW-NOW-P)
+;;; while the subsequent ones at second 0.
+(let ((schedule (clon:make-typed-cron-schedule :minute '*)))
+  (clon:schedule-function 'say-hello
+                          (clon:make-scheduler schedule :allow-now-p t)
+                          :name "Hello world 2"
+                          :thread t))
+
+;;; Let's do something moderately fancy. Take second 0 and 15 in even minutes
+;;; and second 30 in odd minutes.
+(defun bump-second (second decoded-time n)
+  ;; Check that we are indeed the bumper of seconds.
+  (assert (= n 0))
+  ;; Be painfully correct and return NIL if there is no next second in
+  ;; this minute that we want.
+  (cond ((oddp (elt decoded-time 1)) 30)
+        ((< 15 second) nil)
+        ((< 0 second) 15)
+        (t 0))
+  ;; Or rely on the fact that values less than the current SECOND are
+  ;; treated as NIL.
+  #+nil
+  (cond ((oddp (elt decoded-time 1)) 30)
+        ((<= 15) 15)
+        (t 0)))
+
+(let ((schedule (clon:make-cron-schedule :second 'bump-second)))
+  (clon:schedule-function 'say-hello
+                          (clon:make-scheduler schedule)
+                          :name "Hello world 3"
+                          :thread t))
+
+;;; Unschedule all timers.
+(mapc #'sb-ext:unschedule-timer (list-all-timers))

packages.lisp

@@ -0,0 +1,16 @@
+(cl:defpackage :clon
+  (:use #:common-lisp)
+  #+sbcl
+  (:import-from :sb-impl #:leap-years-before)
+  (:export
+   ;; Generic interface
+   #:*default-next-time-limit*
+   #:next-time
+   #:make-scheduler
+   #:schedule-function
+   ;; Cron
+   #:cron-schedule
+   #:make-cron-schedule
+   #:make-typed-cron-schedule
+   #:find-decoded-time-component-by-type
+   #:make-typed-cron-bumper))

test-packages.lisp

@@ -0,0 +1,3 @@
+(cl:defpackage :clon-test
+  (:use #:common-lisp #:clon)
+  (:export #:test-clon))