├── clerk.asd ├── t ├── time.lisp └── clerk.lisp ├── src ├── time.lisp └── clerk.lisp └── README.md /clerk.asd: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:clerk-asd 3 | (:use #:cl #:asdf)) 4 | (in-package #:clerk-asd) 5 | 6 | (defsystem #:clerk 7 | :version "0.1.0" 8 | :description "A cron-like scheduler with sane DSL" 9 | :author "Petko Tsikov " 10 | :serial t 11 | :license "MIT" 12 | :depends-on (#:bordeaux-threads #:cl-ppcre) 13 | :components ((:module "src" 14 | :components 15 | ((:file "time") 16 | (:file "clerk")))) 17 | :in-order-to ((test-op (test-op clerk-test)))) 18 | 19 | (defsystem #:clerk-test 20 | :description "A test system for clerk" 21 | :author "Petko Tsikov " 22 | :license "MIT" 23 | :depends-on (#:prove) 24 | :defsystem-depends-on (#:prove-asdf) 25 | :serial t 26 | :components ((:module "t" 27 | :components 28 | ((:test-file "clerk") 29 | (:test-file "time")))) 30 | :perform (test-op :after (op c) 31 | (funcall (intern #.(string :run) :prove) c))) 32 | -------------------------------------------------------------------------------- /t/time.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:clerk.time.test 3 | (:use #:cl #:prove)) 4 | (in-package #:clerk.time.test) 5 | 6 | (plan 1) 7 | 8 | (subtest "package clerk.time.test" 9 | (is (multiple-value-list 10 | (clerk.time::split-interval '1.minute)) 11 | '(1 minute) 12 | "Can split numbered interval" 13 | :test #'equalp) 14 | 15 | (is (clerk.time::interval-type->seconds 'minute) 16 | 60 17 | "Can convert interval-type to seconds") 18 | 19 | (is (clerk.time::interval->seconds '2.minutes) 20 | 120 21 | "Can convert numbered interval to seconds") 22 | (is (clerk.time::interval->seconds '1.hour) 23 | 360 24 | "Can convert numbered interval to seconds") 25 | (is (clerk.time::interval->seconds (list 1 'minute)) 26 | 60 27 | "Can convert a numbered interval presented as a list to seconds") 28 | 29 | (ok (typep (clerk.time::interval->seconds 'friday) 'number) 30 | "Days of the week return the remaining seconds until this time") 31 | 32 | (is (clerk.time:timejump 0 '1.minute) 33 | 60 34 | "Can move the time with a numbered interval")) 35 | 36 | (finalize) 37 | -------------------------------------------------------------------------------- /t/clerk.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:clerk.test 3 | (:use #:cl #:prove)) 4 | (in-package #:clerk.test) 5 | 6 | (plan 1) 7 | 8 | (subtest "package clerk.test" 9 | (subtest "function (make-job" 10 | (is (type-of (clerk::make-job "Friendly job" 11 | 'every 12 | '5.minutes 13 | '(print "Hi!"))) 14 | 'continuous-job 15 | "Can make continuous job" 16 | :test #'string=) 17 | (is (type-of (clerk::make-job "Friendly job" 18 | 'in 19 | '1.day 20 | '(print "Hi!"))) 21 | 'one-time-job 22 | "Can make one-time job" 23 | :test #'string=)) 24 | 25 | (clerk:empty-jobs-queue) 26 | (subtest "macro (job ..." 27 | (clerk:job "Cool job" every 5.days (print "Party!")) 28 | (is (length clerk:*jobs*) 29 | 1 30 | "Adds an job to the jobs queue.") 31 | 32 | (clerk:empty-jobs-queue) 33 | (clerk:job "First job to fire" 34 | in 1.minute (print "Fire!")) 35 | (clerk:job "Second job to fire" 36 | in 2.minutes (print "Fire!")) 37 | (with-slots (clerk::name) (first clerk:*jobs*) 38 | (is clerk::name "First job to fire" 39 | "Orders jobs by time of firing." 40 | :test #'string=))) 41 | 42 | (subtest "function (job-fn" 43 | (clerk:empty-jobs-queue) 44 | (clerk:job-fn "Test job-fn" 'every '1.minute #'(lambda () (print "Fire!"))) 45 | (with-slots (clerk::name) (first clerk:*jobs*) 46 | (is clerk::name "Test job-fn" 47 | "Adds the job to the job queue." 48 | :test #'string=)) 49 | (clerk:job-fn "Test job-fn (interval as a list)" 50 | 'in 51 | (list 5 'seconds) 52 | #'(lambda () (print "Fire!"))) 53 | (with-slots (clerk::name) (first clerk:*jobs*) 54 | (is clerk::name "Test job-fn (interval as a list)" 55 | "Adds the job to the job queue. Can decipher interval as a list" 56 | :test #'string=))) 57 | 58 | (clerk:empty-jobs-queue) 59 | (subtest "function (fire-job-p" 60 | (ok (not (clerk::fire-job-p 61 | (make-instance 'clerk:job 62 | :interval '1.minute))) 63 | "Job is not fired before it's time") 64 | (ok (clerk::fire-job-p 65 | (make-instance 'clerk:job 66 | :interval '-1.second)) 67 | "Job is fired when the time comes")) 68 | 69 | (clerk:empty-jobs-queue) 70 | (subtest "defmethod (fire-job" 71 | (let ((job-thread (clerk::fire-job 72 | (clerk:job "One-time job" in 1.second (+ 1 2))))) 73 | (is (bt:join-thread job-thread) 74 | 3 75 | "The job's calculation is performed successfully")) 76 | (is (length clerk:*jobs*) 1 77 | "One-time jobs don't create a new job in the job queue 78 | when they are fired.") 79 | (clerk:empty-jobs-queue) 80 | (clerk::fire-job 81 | (clerk:job "Continuous job" every 1.second (+ 1 2))) 82 | (is (length clerk:*jobs*) 2 83 | "Continuous jobs create a new job in the job queue when 84 | when they are fired"))) 85 | 86 | (finalize) 87 | -------------------------------------------------------------------------------- /src/time.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:clerk.time 3 | (:use #:cl) 4 | (:export #:timejump)) 5 | (in-package #:clerk.time) 6 | 7 | (defparameter *days-of-the-week* '(monday tuesday wednesday thursday 8 | friday saturday sunday)) 9 | 10 | (defun split-interval (interval) 11 | (destructuring-bind (n interval-type) 12 | (cl-ppcre:split #\. (string interval)) 13 | (values (parse-integer n) 14 | (intern interval-type)))) 15 | 16 | (defun interval-type->seconds (interval-type) 17 | (cdr (assoc interval-type '((second . 1) 18 | (seconds . 1) 19 | (minute . 60) 20 | (minutes . 60) 21 | (hour . 360) 22 | (hours . 360) 23 | (day . 8640) 24 | (days . 8640) 25 | (week . 60480) 26 | (weeks . 60480) 27 | (month . 241920) 28 | (months . 241920) 29 | ;; years are (* days 365) 30 | ;; regardless if the current year is 31 | ;; a leap year 32 | (year . 3153600) 33 | (years . 3153600)) 34 | :test #'string=))) 35 | 36 | (defun day-of-the-week-p (interval) 37 | (member interval *days-of-the-week* :test #'string=)) 38 | 39 | (defun day-as-number (day-as-symbol) 40 | (position day-as-symbol *days-of-the-week* :test #'string=)) 41 | 42 | (defun current-day-of-the-week () 43 | "Returns the current day of the week as an integer. Monday is 0." 44 | (nth-value 6 45 | (decode-universal-time 46 | (get-universal-time)))) 47 | 48 | (defun days-to-add (current target) 49 | "Calculates how far are the current day of the week to the target 50 | day of the week." 51 | (if (< current target) 52 | (- target current) 53 | (- 7 (- current target)))) 54 | 55 | (defun seconds-to-end-of-the-day (current) 56 | (multiple-value-bind (seconds minutes hours date month year) 57 | (decode-universal-time (+ current 86400)) 58 | (declare (ignore seconds minutes hours)) 59 | (- (encode-universal-time 0 0 0 date month year) current))) 60 | 61 | (defun seconds-to-day-of-the-week (day-of-the-week) 62 | "Returns the seconds to the day of the week" 63 | (+ (seconds-to-end-of-the-day (get-universal-time)) 64 | (* 86400 65 | (1- (days-to-add (current-day-of-the-week) (day-as-number day-of-the-week)))))) 66 | 67 | (defun interval-as-list-p (interval) 68 | "Check if an interval is given as a list" 69 | (consp interval)) 70 | 71 | (defun interval-as-list (interval) 72 | (* (car interval) (interval-type->seconds (cadr interval)))) 73 | 74 | (defun interval->seconds (interval) 75 | (if (interval-as-list-p interval) 76 | (interval-as-list interval) 77 | (cond ((day-of-the-week-p interval) 78 | (seconds-to-day-of-the-week interval)) 79 | (t (multiple-value-bind (n interval-type) 80 | (split-interval interval) 81 | (* n 82 | (interval-type->seconds interval-type))))))) 83 | 84 | (defun timejump (start-time interval) 85 | (+ start-time (interval->seconds interval))) 86 | -------------------------------------------------------------------------------- /src/clerk.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:clerk 3 | (:use #:cl) 4 | (:export #:*jobs* 5 | #:empty-jobs-queue 6 | #:job 7 | #:job-fn 8 | #:start 9 | #:stop 10 | #:calendar)) 11 | (in-package #:clerk) 12 | 13 | (defparameter *jobs* nil 14 | "All scheduled jobs") 15 | (defparameter *main-thread* nil) 16 | 17 | (defclass job () 18 | ((name :initarg :name :reader name) 19 | (interval :initarg :interval :reader interval) 20 | (fire-time :initarg :fire-time :accessor fire-time) 21 | (body :initarg :body :reader body))) 22 | 23 | (defclass continuous-job (job) ()) 24 | (defclass one-time-job (job) ()) 25 | 26 | (defmethod initialize-instance :after ((job job) &key) 27 | (let ((fire-time (clerk.time:timejump (get-universal-time) 28 | (interval job)))) 29 | (setf (fire-time job) 30 | fire-time))) 31 | 32 | (defun continuous-p (type) 33 | "Only interval declared with `every` are considered continuous" 34 | ;; string= will do package agnostic symbol comparison 35 | (string= type 'every)) 36 | 37 | (defun make-job (name type interval body) 38 | (let ((job-class (if (continuous-p type) 39 | 'continuous-job 40 | 'one-time-job))) 41 | (make-instance job-class 42 | :name name 43 | :interval interval 44 | :body body))) 45 | 46 | (defmacro job (name type interval body) 47 | `(add-to-jobs-queue ,name ',type ',interval 48 | (lambda () ,body))) 49 | 50 | (defun job-fn (name type interval fn) 51 | (add-to-jobs-queue name type interval fn)) 52 | 53 | (defun add-to-jobs-queue (name type interval fn) 54 | (let ((job (make-job name type interval fn))) 55 | (push job *jobs*) 56 | (sort *jobs* #'< :key #'fire-time) 57 | job)) 58 | 59 | (defun empty-jobs-queue () 60 | (setf *jobs* nil)) 61 | 62 | (defun fire-job-p (job) 63 | "Check if it is time to fire a job" 64 | (<= (fire-time job) (get-universal-time))) 65 | 66 | (defmethod fire-job ((job job)) 67 | (bt:make-thread (body job) :name (name job))) 68 | 69 | (defmethod fire-job :before ((job continuous-job)) 70 | "Create the next job in the job queue when firing continuous 71 | jobs." 72 | (with-slots (name interval body) job 73 | (add-to-jobs-queue name 'every interval body))) 74 | 75 | (defun fire-job-if-needed () 76 | (if (fire-job-p (car *jobs*)) 77 | (progn 78 | (fire-job (pop *jobs*)) 79 | ;; just in case the second job in queue is the same 80 | ;; second as the first one. Or there might be a lot of 81 | ;; jobs in the queue. 82 | (fire-job-if-needed)))) 83 | 84 | (defun start () 85 | "Start the thread that waits for a jobs to fire." 86 | (setf *main-thread* 87 | (bt:make-thread 88 | #'(lambda () 89 | (loop 90 | (fire-job-if-needed) 91 | (sleep 1))) 92 | :name "Main scheduler thread."))) 93 | 94 | (defun stop () 95 | "Stop scheduler" 96 | (bt:destroy-thread *main-thread*) 97 | (setf *main-thread* nil)) 98 | 99 | (defun calendar (&optional (stream *standard-output*)) 100 | "Print the scheduled jobs" 101 | (format stream "JOBS:~%") 102 | (loop for job in *jobs* 103 | do (with-slots (name interval fire-time) job 104 | (format stream "~A - ~A - ~A~%" name interval fire-time)))) 105 | 106 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Clerk 2 | 3 | A cron-like scheduler with sane DSL 4 | 5 | ## Example usage 6 | 7 | ### Job MACRO 8 | 9 | ``` 10 | (job "Say 'Hi' all the time" every 5.seconds (print "Hi")) 11 | 12 | (job "Compose and send monthly report" 13 | every 1.month (send-report (compose-monthly-report))) 14 | ``` 15 | 16 | If you want to see it with your eyes, make sure to load the following code: 17 | 18 | ``` 19 | (defun write-to-file (msg file) 20 | (with-open-file (log file 21 | :direction :output 22 | :if-exists :append 23 | :if-does-not-exist :create) 24 | (format log "~A~%" msg))) 25 | 26 | (job "Print farbe" every 3.seconds (write-to-file "Farbe" "log.txt")) 27 | (job "Print colour" every 2.seconds (write-to-file "Colour" "log.txt")) 28 | (job "Print @@@@ 1 min @@@@@" every 1.minute 29 | (write-to-file "@@@@@@ 1 min @@@@@@" "log.txt")) 30 | ``` 31 | Now, after `(clerk:start)`, tailing `log.txt` should give you something like this: 32 | 33 | ``` 34 | Colour 35 | Farbe 36 | Colour 37 | Colour 38 | Farbe 39 | Colour 40 | Farbe 41 | Colour 42 | Colour 43 | Farbe 44 | Colour 45 | /one minute later.../ 46 | @@@@@@ 1 min @@@@@@ 47 | /etc.../ 48 | ``` 49 | 50 | ### Job FUNCTION 51 | 52 | The original idea was for users to use the library to execute some sort of execution of a configuration file. However you can use the job creation process programatically with the underlying function `job-fn`. E.g.: 53 | 54 | ``` 55 | (defparameter *query-interval* 5) 56 | (job-fn (format nil "Query the API every ~A seconds" *query-interval*) 57 | 'every 58 | `(,*query-interval* seconds) 59 | #'query-api-fn) 60 | ``` 61 | 62 | As you can see, you have to provide a function (either anonimous function or a function symbol) as the last argument. 63 | 64 | ## Instalation and usage 65 | 66 | Clone the repo inside `quicklisp/local-projects` and do `(ql:quicklisp :clerk)` in your REPL. 67 | 68 | Make sure your jobs are loaded before executing `(clerk:start)`. The jobs reside inside `clerk:*jobs*`, but you can also type `(clerk:calendar)` to see a list of all scheduled and running jobs. 69 | 70 | ### Job types 71 | 72 | There are two types of jobs - `continuous` and `one-time`. If a job has the keyword `every` after the job description - the job will be countinuous. This means that when an event is fired, a new event will be pushed in the event queue for firing exactly `interval` time from now. The jobs above are an example for `continuous` jobs. 73 | 74 | A `one-time` job is fired once and then it is removed from the jobs' queue. An example for a one-time job can be: 75 | 76 | ``` 77 | (job "Extraordinary event" in 5.days (send-mail "Don't forget X")) 78 | ``` 79 | 80 | You can use any word instead of `in`. 81 | 82 | ### Intervals 83 | 84 | Right now (more are coming soon) there are 2 type of intervals: 85 | 86 | 1) **Numbered intervals** 87 | 88 | ``` 89 | [number].[interval-type] 90 | ``` 91 | 92 | where the number is a positive integer and the `interval-type` if one of the following: `second`, `minute`, `hour`, `day`, `week`, `month`, `year`. Also you can use the plural form of all these words. For example `1.second` and `2.seconds` are both valid. 93 | 94 | 2) **Days of the week** 95 | 96 | ``` 97 | (job "Weekly report" every monday (create-report)) 98 | ``` 99 | 100 | Pretty self-explanatory. The idea is that if you type the day of the week, clerk will calculate when it is and add an event to the queue. 101 | 102 | ## Issues / Contribution 103 | 104 | If you have issues - open a github issue or contact me at `(reverse "moc.liamg@vokist")`. If you want to contribute - open an issue or make a PR. Thanks! 105 | --------------------------------------------------------------------------------