(in-package :cl-user) (defpackage chatikbot.chat-cron (:use :cl :chatikbot.utils :chatikbot.db :chatikbot.macros) (:export :add-chat-cron :get-chat-crons :delete-chat-cron :def-chat-cron-handler)) (in-package :chatikbot.chat-cron) (def-db-init (db-execute "create table if not exists chat_crons (type, chat_id, schedule, args, last_run)")) (defun add-chat-cron (type chat-id schedule &rest args) (apply #'clon:make-typed-cron-schedule (read-from-string schedule)) ;; Validate schedule (db-execute "insert into chat_crons (type, chat_id, schedule, args) values (?, ?, ?, ?)" (symbol-name type) chat-id schedule (write-to-string args))) (defun get-chat-crons (type chat-id) (loop for (schedule args) in (db-select "select schedule, args from chat_crons where type = ? and chat_id = ?" (symbol-name type) chat-id) collect (append (list schedule) (read-from-string args)))) (defun delete-chat-cron (type chat-id index) (let ((crons (db-select "select schedule, args from chat_crons where type = ? and chat_id = ?" (symbol-name type) chat-id))) (destructuring-bind (schedule args) (nth index crons) (db-execute "delete from chat_crons where type = ? and chat_id = ? and schedule = ? and args = ?" (symbol-name type) chat-id schedule args)))) (defcron chat-crons-handler () (let ((now (get-universal-time))) (loop for (type chat-id schedule-text args last-run) in (db-select "select type, chat_id, schedule, args, last_run from chat_crons") for schedule = (apply #'clon:make-typed-cron-schedule (read-from-string schedule-text)) for next-time = (clon:next-time schedule :allow-now-p t :now (or last-run now)) when (and next-time (<= next-time now)) do (unwind-protect (apply #'run-hooks :chat-cron (keyify type) chat-id schedule (read-from-string args)) (db-execute "update chat_crons set last_run = ? where type = ? and chat_id = ? and schedule = ? and args = ?" next-time type chat-id schedule-text args))))) (defmacro def-chat-cron-handler (name (type &rest args) &body body) (let ((var-type (gensym "TYPE"))) `(progn (defun ,name (,var-type ,@args) (declare (ignorable ,@args)) (when (eql ,type ,var-type) ,@body)) (add-hook :chat-cron ',name))))