example.lisp 2.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. (in-package :cl-user)
  2. ;;; If this runs under SLIME you may have to look into the
  3. ;;; *inferior-lisp* buffer to see the output depending on your setup.
  4. (let ((n 0))
  5. (defun say-hello ()
  6. (incf n)
  7. (format t "Hello world ~D at ~S~%" n
  8. (multiple-value-list (decode-universal-time (get-universal-time))))
  9. (force-output)))
  10. ;;; SCHEDULE is not mutated by iterating over it by NEXT-TIME. A
  11. ;;; SCHEDULER on the other hand is all about remembering the last
  12. ;;; time. The schedule here reads as: 'seconds 0, 15, 30 and 45 of
  13. ;;; every even minute that's between 10 and 40'.
  14. (let ((schedule (clon:make-typed-cron-schedule
  15. :second '(member 0 15 30 45)
  16. :minute '(and (integer 10 40) (satisfies evenp)))))
  17. (clon:schedule-function 'say-hello
  18. (clon:make-scheduler schedule)
  19. :name "Hello world 1"
  20. :thread t))
  21. ;;; SCHEDULE-FUNCTION returned a timer, stop it when we got bored of it.
  22. (sb-ext:unschedule-timer *)
  23. ;;; Do something even more simple: say hello once every minute. Note
  24. ;;; that the first one will happen immediately (thanks to ALLOW-NOW-P)
  25. ;;; while the subsequent ones at second 0.
  26. (let ((schedule (clon:make-typed-cron-schedule :minute '*)))
  27. (clon:schedule-function 'say-hello
  28. (clon:make-scheduler schedule :allow-now-p t)
  29. :name "Hello world 2"
  30. :thread t))
  31. ;;; Let's do something moderately fancy. Take second 0 and 15 in even minutes
  32. ;;; and second 30 in odd minutes.
  33. (defun bump-second (second decoded-time n)
  34. ;; Check that we are indeed the bumper of seconds.
  35. (assert (= n 0))
  36. ;; Be painfully correct and return NIL if there is no next second in
  37. ;; this minute that we want.
  38. (cond ((oddp (elt decoded-time 1)) 30)
  39. ((< 15 second) nil)
  40. ((< 0 second) 15)
  41. (t 0))
  42. ;; Or rely on the fact that values less than the current SECOND are
  43. ;; treated as NIL.
  44. #+nil
  45. (cond ((oddp (elt decoded-time 1)) 30)
  46. ((<= 15) 15)
  47. (t 0)))
  48. (let ((schedule (clon:make-cron-schedule :second 'bump-second)))
  49. (clon:schedule-function 'say-hello
  50. (clon:make-scheduler schedule)
  51. :name "Hello world 3"
  52. :thread t))
  53. ;;; Unschedule all timers.
  54. (mapc #'sb-ext:unschedule-timer (list-all-timers))