| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629 |
- (in-package #:chatikbot)
- ;; Load config file
- (alexandria:when-let (file (probe-file
- (merge-pathnames "config.lisp"
- (asdf:component-pathname
- (asdf:find-system '#:chatikbot)))))
- (load file))
- ;; Init database
- (db-init)
- (defvar *telegram-last-update* nil "Telegram last update_id")
- (defvar *admins* nil "Admins chat-ids")
- (defun process-updates ()
- (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
- (1+ *telegram-last-update*))
- :timeout 300)
- do (setf *telegram-last-update*
- (max (or *telegram-last-update* 0)
- (aget "update_id" update)))
- do (handle-message (aget "message" update))))
- (defun send-response (chat-id response &optional reply-id)
- (if (consp response)
- (if (keywordp (car response))
- (case (car response)
- (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
- (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
- (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
- (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
- (telegram-send-message chat-id response :reply-to reply-id)))
- (defun send-dont-understand (chat-id &optional text reply-id)
- (let ((resp (eliza text)))
- (log:info text resp)
- (when resp
- (send-response chat-id resp reply-id))))
- (defvar *chat-locations* nil "ALIST of chat->location")
- (defun preprocess-input (text)
- (when text
- (let ((first-word (subseq text 0 (position #\Space text))))
- (if (equal first-word "@chatikbot")
- (preprocess-input (subseq text 11))
- (replace-all text "@chatikbot" "ты")))))
- (defun parse-cmd (text)
- (let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))
- (cmd (subseq (car args) 0 (position #\@ (car args)))))
- (values (intern (string-upcase cmd) "KEYWORD") (rest args))))
- (defun handle-message (message)
- (let ((id (aget "message_id" message))
- (chat-id (aget "id" (aget "chat" message)))
- (text (aget "text" message))
- (location (aget "location" message))
- (sticker (aget "file_id" (aget "sticker" message))))
- (log:info "handle-message" message)
- (when text
- (if (equal #\/ (char text 0))
- (multiple-value-bind (cmd args) (parse-cmd text)
- (case cmd
- (:postakb (handle-cmd-post-akb chat-id id args))
- (:akb (handle-cmd-akb chat-id id args))
- (:weather (handle-cmd-weather chat-id id args))
- (:hourly (handle-cmd-weather chat-id id '("hourly")))
- (:daily (handle-cmd-weather chat-id id '("daily")))
- (:rates (handle-cmd-rates chat-id id args))
- (:charts (handle-cmd-charts chat-id id args))
- (:postcheckins (handle-cmd-post-checkins chat-id id args))
- (:friends (handle-cmd-fsq-friends chat-id id args))
- (:checkins (handle-cmd-checkins chat-id id args))
- (:rss (handle-cmd-rss chat-id id args))
- (:feeds (handle-cmd-feeds chat-id id args))
- (:lastrss (handle-cmd-last-rss chat-id id args))
- (:wall (handle-cmd-wall chat-id id args))
- (otherwise (handle-admin-cmd chat-id text cmd args))))
- (send-dont-understand chat-id (preprocess-input text))))
- (when location
- (push (cons chat-id location) *chat-locations*)
- (telegram-send-message chat-id "Взял на карандаш")
- (save-settings))
- (when sticker
- (send-dont-understand chat-id))))
- (defmacro handling-errors (&body body)
- `(handler-case (progn ,@body)
- (simple-condition (err)
- (format *error-output* "~&~A: ~%" (class-name (class-of err)))
- (apply (function format) *error-output*
- (simple-condition-format-control err)
- (simple-condition-format-arguments err))
- (format *error-output* "~&"))
- (condition (err)
- (format *error-output* "~&~A: ~% ~S~%"
- (class-name (class-of err)) err))))
- (defun rep (input)
- (when input
- (with-output-to-string (*standard-output*)
- (let ((*package* (find-package 'chatikbot))
- (*error-output* *standard-output*))
- (handling-errors
- (format t "~{~S~^ ;~% ~}~%"
- (multiple-value-list (eval (read-from-string input)))))))))
- (defun handle-admin-cmd (chat-id text cmd args)
- (if (find chat-id *admins*)
- (case cmd
- (:eval (telegram-send-message chat-id (rep (format nil "~{~A~^ ~}" args))))
- (otherwise (send-dont-understand chat-id (preprocess-input (subseq text 1)))))
- (send-dont-understand chat-id (preprocess-input (subseq text 1)))))
- ;; AKB
- (defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'")
- (defvar *akb-send-to* nil "List of chat-id's to send AKBs to")
- (defun handle-cmd-post-akb (chat-id message-id args)
- (log:info "handle-cmd-post-akb" chat-id message-id args)
- (let ((message "Хуярим аники"))
- (if (member chat-id *akb-send-to*)
- (setf message "Не хуярим больше аники"
- *akb-send-to* (set-difference *akb-send-to*
- (list chat-id)))
- (setf *akb-send-to* (cons chat-id *akb-send-to*)))
- (telegram-send-message chat-id message)
- (save-settings)))
- (defvar *akb-max-count* 5 "Max number of tweets to return per run")
- (defvar *akb-last-id* 0 "id of last AKB tweet")
- (defun format-akb (post)
- (let* ((id (aget "id" post))
- (url (format nil "https://vk.com/~A?w=wall~A_~A"
- +akb-vk-domain+ (aget "from_id" post) id)))
- (format nil "~A~%~A" (aget "text" post) url)))
- (defun process-latest-akb ()
- (handler-case
- (dolist (post (reverse (aget "items" (vk-wall-get :domain +akb-vk-domain+
- :count *akb-max-count*))))
- (let ((id (aget "id" post)))
- (when (> id *akb-last-id*)
- (send-akb (format-akb post))
- (setf *akb-last-id* id)
- (save-settings))))
- (error (e) (log:error "~A" e))))
- (defun send-akb (text)
- (log:info "send-akb: ~A" text)
- (dolist (chat-id *akb-send-to*)
- (handler-case
- (telegram-send-message chat-id text
- :disable-web-preview 1)
- (error (e) (log:error "~A" e)))))
- (defun handle-cmd-akb (chat-id message-id args)
- (log:info "handle-cmd-akb" chat-id message-id args)
- (handler-case
- (progn
- (let ((total-aneks
- (aget "count" (vk-wall-get :domain +akb-vk-domain+ :count 1 :offset 10000000))))
- (dolist (post (aget "items" (vk-wall-get :domain +akb-vk-domain+
- :count (or (ignore-errors (parse-integer (car args))) 1)
- :offset (random total-aneks))))
- (handler-case
- (telegram-send-message chat-id
- (format-akb post)
- :disable-web-preview 1)
- (error (e) (log:error e))))))
- (error (e)
- (log:error "~A" e)
- (telegram-send-message chat-id "Ошибочка вышла"))))
- ;; Finance
- (defun process-rates ()
- (handler-case
- (let ((ts (local-time:timestamp-to-unix (local-time:now)))
- (rates (get-rates))
- (brent (get-brent))
- (btc (get-btc-e)))
- (db-add-finance ts (aget "USD/RUB" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc))
- (error (e) (log:error "~A" e))))
- (defun handle-cmd-rates (chat-id message-id args)
- (log:info "handle-cmd-rates" chat-id message-id args)
- (multiple-value-bind (ts usd eur gbp brent btc) (db-get-last-finance)
- (telegram-send-message chat-id
- (format nil "Зеленый *~,2F*, гейро *~,2F*, британец *~,2F*, чёрная *~,2F*, btc *~,2F* @ _~A_"
- usd eur gbp brent btc
- (format-ts (local-time:unix-to-timestamp ts)))
- :parse-mode "Markdown")))
- (defparameter +chart-ranges+ (list (cons "day" (* 24 60))
- (cons "week" (* 7 24 60))
- (cons "month" (* 30 24 60))
- (cons "quarter" (* 91 24 60))
- (cons "year" (* 365 24 60))))
- (defun handle-cmd-charts (chat-id message-id args)
- (log:info "handle-cmd-charts" chat-id message-id args)
- (telegram-send-chat-action chat-id "upload_photo")
- (handler-case
- (let* ((args (mapcar 'string-downcase args))
- (all-fields (mapcar #'car +db-finance-map+))
- (fields (or (intersection args all-fields :test 'equal) all-fields))
- (day-range (some #'(lambda (a) (aget a +chart-ranges+)) args))
- (number (some #'(lambda (a) (parse-integer a :junk-allowed t)) args))
- (avg (* 60 (cond
- (day-range (round day-range *chart-points*))
- (number)
- (:otherwise 1))))
- (after-ts (local-time:timestamp- (local-time:now)
- (* avg *chart-points*) :sec))
- (rates (multiple-value-list (db-get-last-finance)))
- (chart (apply #'make-chart (multiple-value-list
- (db-get-series after-ts fields avg)))))
- (telegram-send-photo chat-id chart
- :caption
- (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F, btc ~,2F @ ~A"
- (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4) (elt rates 5)
- (format-ts (local-time:unix-to-timestamp (elt rates 0))))))
- (error (e)
- (log:error "~A" e)
- (telegram-send-message chat-id "Хуйня какая-то"))))
- ;; Weather
- (defun handle-cmd-weather (chat-id message-id args)
- (log:info "handle-cmd-weather" chat-id message-id args)
- (let ((location (cdr (assoc chat-id *chat-locations*))))
- (telegram-send-message
- chat-id
- (if location
- (handler-case
- (forecast-format (forecast
- (aget "latitude" location)
- (aget "longitude" location)
- :hourly (find "hourly" args :key #'string-downcase :test #'equal)
- :daily (find "daily" args :key #'string-downcase :test #'equal)))
- (error (e)
- (log:error "~A" e)
- "Ошибочка вышла"))
- "Так а ты чьих будешь?"))))
- ;; Foursquare
- (defun fsq-user-name (user)
- (when user
- (format nil "~@[~A~]~@[ ~A~]"
- (aget "firstName" user)
- (aget "lastName" user))))
- (defun handle-cmd-post-checkins (chat-id message-id args)
- (log:info "handle-cmd-post-checkins" chat-id message-id args)
- (handler-case
- (let ((users (db-fsq-get-chat-users chat-id))
- (friends (fsq-fetch-friends)))
- (if (null args)
- (telegram-send-message chat-id
- (if (null users)
- "Пока никого не палим"
- (format nil "Палим ~{~A~^, ~}"
- (loop for user in friends
- when (member (aget "id" user)
- users :test #'equal)
- collect (fsq-user-name user)))))
- (progn
- (dolist (user args)
- (let ((username (fsq-user-name
- (find user friends
- :test #'equal
- :key #'(lambda (f) (aget "id" f))))))
- (when username
- (if (member user users :test #'equal)
- (progn
- (setf users (remove user users :test #'equal))
- (telegram-send-message chat-id
- (format nil "Больше не палим ~A" username)))
- (progn
- (push user users)
- (telegram-send-message chat-id (format nil "Теперь палим ~A" username)))))))
- (db-fsq-set-chat-users chat-id users))))
- (error (e)
- (log:error "~A" e)
- (telegram-send-message chat-id "Ошибочка вышла"))))
- (defun handle-cmd-fsq-friends (chat-id message-id args)
- (log:info "handle-cmd-fsq-friends" chat-id message-id args)
- (handler-case
- (let ((users (db-fsq-get-chat-users chat-id))
- (friends (fsq-fetch-friends)))
- (telegram-send-message
- chat-id
- (format
- nil "~{~A: ~:[~;📍 ~]~A~^~%~}"
- (loop for user in friends
- append (list
- (aget "id" user)
- (member (aget "id" user) users :test #'equal)
- (fsq-user-name user))))))
- (error (e) (log:error "~A" e))))
- (defun handle-cmd-checkins (chat-id message-id args)
- (log:info "handle-cmd-checkins" chat-id message-id args)
- (handler-case
- (let ((users (db-fsq-get-chat-users chat-id)))
- (when users
- (telegram-send-message
- chat-id
- (format nil "~{~A~^~%~}"
- (loop for checkin in (fsq-fetch-checkins)
- if (member (aget "id" (aget "user" checkin)) users :test #'equal)
- collect (fsq-format-checkin checkin t))))))
- (error (e) (log:error "~A" e))))
- (defun process-latest-checkins ()
- (handler-case
- (let ((checkins (make-hash-table))
- (ts (princ-to-string (1+ (or (db-fsq-last-created) -1)))))
- (dolist (checkin (fsq-fetch-checkins ts))
- (let ((id (aget "id" checkin))
- (created-at (aget "createdAt" checkin))
- (user (aget "id" (aget "user" checkin))))
- (unless (db-fsq-has-seen id)
- (dolist (chat-id (db-fsq-get-user-chats user))
- (push (fsq-format-checkin checkin)
- (gethash chat-id checkins)))
- (db-fsq-add-seen id created-at))))
- (loop for chat-id being the hash-keys in checkins using (hash-value texts)
- do (log:info "Sending checkins" chat-id texts)
- (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts))))
- (error (e) (log:error "~A" e))))
- ;; RSS
- (defun handle-cmd-feeds (chat-id message-id args)
- (log:info "handle-cmd-feeds" chat-id message-id args)
- (handler-case
- (telegram-send-message
- chat-id
- (if (null args)
- "URL давай"
- (format nil "~:[Не нашел RSS там~;~:*~{~{~A - ~A~}~^~%~}~]"
- (find-rss-links (car args))))
- :disable-web-preview 1)
- (condition (e)
- (log:error "~A" e)
- (telegram-send-message chat-id "Ошибочка вышла"))))
- (defun %send-feeds (chat-id feeds)
- (telegram-send-message
- chat-id
- (if (null feeds)
- "Пока ничего не постим"
- (format nil "Постим~%~{~A) ~A: ~A~^~%~}"
- (loop for feed in feeds
- for index from 1
- append (list index (feed-title feed) (feed-url feed)))))
- :disable-web-preview 1))
- (defun %fetch-new-items (feed)
- (loop for item in (refresh-feed feed #'db-rss-item-exists)
- do (db-rss-add-item item)
- collect item))
- (defun %get-feed (url)
- (when url
- (or (db-rss-get-feed-by-url url)
- (alexandria:when-let (feed (build-feed url))
- (log:info "Added feed" feed)
- (db-rss-add-feed feed)
- (%fetch-new-items feed)
- feed))))
- (defun handle-cmd-rss (chat-id message-id args)
- (log:info "handle-cmd-rss" chat-id message-id args)
- (handler-case
- (let ((feeds (db-rss-get-chat-feeds chat-id)))
- (if (null args)
- (%send-feeds chat-id feeds)
- (progn
- (dolist (url args)
- (handler-case
- (let ((idx (parse-integer url)))
- (when (<= idx (length feeds))
- (setf feeds (remove (nth (1- idx) feeds) feeds))))
- (parse-error ()
- (alexandria:when-let (feed (%get-feed
- (or (cadar (find-rss-links url))
- url)))
- (let ((existing (find (feed-url feed) feeds :key #'feed-url :test #'equal)))
- (if existing
- (setf feeds (remove existing feeds))
- (push feed feeds)))))
- (error (e) (log:error "~A" e))))
- (db-rss-set-chat-feeds chat-id feeds)
- (%send-feeds chat-id (db-rss-get-chat-feeds chat-id)))))
- (condition (e)
- (log:error "~A" e)
- (telegram-send-message chat-id (format nil "Ошибочка вышла: ~A" e)))))
- (defun handle-cmd-last-rss (chat-id message-id args)
- (log:info "handle-cmd-last-rss" chat-id message-id args)
- (handler-case
- (let ((feeds (db-rss-get-chat-feeds chat-id)))
- (if (null args)
- (%send-feeds chat-id feeds)
- (let* ((idx (1- (parse-integer (car args))))
- (limit (min 20 (if (> (length args) 1) (parse-integer (second args)) 5)))
- (items (db-rss-last-feed-items (nth idx feeds) limit)))
- (telegram-send-message chat-id
- (format nil "~{~A~^~%~%~}"
- (mapcar #'format-feed-item items))
- :parse-mode "Markdown"
- :disable-web-preview 1))))
- (error (e)
- (log:error "~A" e)
- (telegram-send-message chat-id "Ошибочка вышла"))))
- (defun process-feeds ()
- (handler-case
- (dolist (feed (remove-if-not #'need-fetch-p (db-rss-get-active-feeds)))
- (log:info "Fetching new items" (feed-url feed))
- (dolist (item (%fetch-new-items feed))
- (dolist (chat-id (db-rss-get-feed-chats feed))
- (telegram-send-message chat-id
- (format-feed-item item)
- :parse-mode "Markdown"
- :disable-web-preview 1)))
- (db-rss-update-feed feed)) ;; Update next fetch and period
- (error (e) (log:error "~A" e))))
- ;; VK walls
- (defun %send-domains (chat-id domains)
- (telegram-send-message
- chat-id
- (if (null domains)
- "Пока ничего не постим"
- (format nil "Постим~%~{~A) https://vk.com/~A~^~%~}"
- (loop for d in domains for i from 1 append (list i d))))
- :disable-web-preview 1))
- (defun %find-vk-domain (url)
- (let ((path (puri:uri-path (puri:parse-uri url))))
- (if (equal #\/ (elt path 0))
- (subseq path 1)
- path)))
- (defun %ensure-domain (domain)
- (let* ((res (vk-wall-get :domain domain :count 1))
- (last-id (aget "id" (first (aget "items" res)))))
- (db-vk-ensure-domain domain last-id)
- domain))
- (defun %vk-find-best-photo (attach)
- (when attach
- (let* ((photo (aget "photo" attach))
- (sizes (loop for (k . v) in photo
- when (equal "photo_" (subseq k 0 (min 6 (length k))))
- collect (cons (parse-integer (subseq k 6)) v))))
- (cdr (assoc (apply #'max (mapcar #'car sizes)) sizes)))))
- (defun %vk-find-video (attach)
- (when attach
- (let ((video (aget "video" attach)))
- (format nil "https://vk.com/video~A_~A"
- (aget "owner_id" video)
- (aget "id" video)))))
- (defun %vk-find-preview (attachments)
- (labels ((find-type (type)
- (find type attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
- (or
- (%vk-find-best-photo (find-type "photo"))
- (%vk-find-video (find-type "video")))))
- (defparameter +vk-link-scanner+ (cl-ppcre:create-scanner "\\[((id|club)\\d+)\\|([^\\]]*?)\\]") "vk linking regex")
- (defun %vk-post-text (post)
- (let* ((history (aget "copy_history" post))
- (reposts (loop for p in history
- collect (let* ((owner (aget "owner_id" p))
- (type (if (> owner 0) "id" "club"))
- (id (abs owner)))
- (format nil "[~A](https://vk.com/~A~A)"
- (vk-get-name owner) type id)))))
- (when history
- (setf post (car (last history))))
- (values
- (cl-ppcre:regex-replace-all +vk-link-scanner+
- (aget "text" post)
- "[\\3](https://vk.com/\\1)")
- (%vk-find-preview (aget "attachments" post))
- reposts)))
- (defun %format-wall-post (domain name post)
- (multiple-value-bind (text preview reposts) (%vk-post-text post)
- (values
- (format nil "~@[[✅](~A) ~][~A](https://vk.com/~A?w=wall~A_~A)~@[ ~{↩ ~A~}~]~@[ @ ~A~]~%~A"
- preview name domain (aget "from_id" post) (aget "id" post)
- reposts (format-ts (local-time:unix-to-timestamp (aget "date" post)))
- text)
- (if preview 0 1))))
- (defun handle-cmd-wall (chat-id message-id args)
- (log:info "handle-cmd-wall" chat-id message-id args)
- (handler-case
- (let ((domains (db-vk-get-chat-domains chat-id)))
- (if (null args)
- (%send-domains chat-id domains)
- (progn
- (dolist (url args)
- (handler-case
- (let ((idx (parse-integer url)))
- (db-vk-remove-chat-domain chat-id (nth (1- idx) domains)))
- (parse-error ()
- (let* ((domain (%ensure-domain (%find-vk-domain url)))
- (existing (find domain domains :test #'equal)))
- (if existing
- (db-vk-remove-chat-domain chat-id domain)
- (db-vk-add-chat-domain chat-id domain))))
- (error (e) (log:error "~A" e))))
- (%send-domains chat-id (db-vk-get-chat-domains chat-id)))))
- (error (e)
- (log:error "~A" e)
- (telegram-send-message chat-id (format nil "Ошибочка вышла: ~A" e)))))
- (defun process-walls ()
- (handler-case
- (loop for (domain last-id next-fetch period) in (db-vk-get-active-walls)
- when (or (null next-fetch)
- (local-time:timestamp> (local-time:now) (local-time:unix-to-timestamp next-fetch)))
- do (progn
- (log:info "Fetching wall" domain)
- (handler-case
- (let ((new-posts
- (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
- :test #'>= :key (lambda (p) (aget "id" p))))
- name)
- (setf period (adjust-period period (length new-posts)))
- (when new-posts
- (setf name (vk-get-name domain)))
- (dolist (post new-posts)
- (multiple-value-bind (text disable)
- (%format-wall-post domain name post)
- (dolist (chat-id (db-vk-get-domain-chats domain))
- (ignore-errors
- (telegram-send-message chat-id text
- :parse-mode "Markdown"
- :disable-web-preview disable))))
- (setf last-id (max last-id (aget "id" post)))))
- (error (e) (log:error "~A" e)))
- (db-vk-update-wall domain last-id
- (local-time:timestamp-to-unix
- (local-time:timestamp+ (local-time:now) period :sec))
- period))) ;; Update last-id, next-fetch and period
- (error (e) (log:error "~A" e))))
- (defvar *save-settings-lock* (bordeaux-threads:make-lock "save-settings-lock")
- "Lock for multithreading access to write settings file")
- (defun save-settings()
- (bordeaux-threads:with-lock-held (*save-settings-lock*)
- (with-open-file (s (merge-pathnames "settings.lisp"
- (asdf:component-pathname
- (asdf:find-system '#:chatikbot)))
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create)
- (write '(in-package #:chatikbot) :stream s)
- (write
- `(setf *chat-locations* ',*chat-locations*
- *akb-send-to* ',*akb-send-to*
- *akb-last-id* ,*akb-last-id*)
- :stream s)
- (values))))
- (defvar *schedules* '(process-latest-akb
- process-latest-checkins
- process-rates
- process-feeds
- process-walls) "Enabled schedules")
- (defun start ()
- ;; Clear prev threads
- (mapc #'trivial-timers:unschedule-timer (trivial-timers:list-all-timers))
- (let ((old-updates (find "process-updates"
- (bordeaux-threads:all-threads)
- :key #'bordeaux-threads:thread-name
- :test #'equal)))
- (when old-updates
- (bordeaux-threads:destroy-thread old-updates)))
- ;; Load settings file
- (alexandria:when-let (file (probe-file
- (merge-pathnames "settings.lisp"
- (asdf:component-pathname
- (asdf:find-system '#:chatikbot)))))
- (load file))
- ;; Start timers
- (dolist (func *schedules*)
- (clon:schedule-function func
- (clon:make-scheduler
- (clon:make-typed-cron-schedule :minute '* :hour '*)
- :allow-now-p t)
- :name func
- :thread t))
- ;; YIT
- (let ((last-yit-info))
- (clon:schedule-function
- #'(lambda() (let ((info (yit-info)))
- (when (not (equal info last-yit-info))
- (send-response (car *admins*) info)
- (setf last-yit-info info))))
- (clon:make-scheduler
- (clon:make-typed-cron-schedule :minute 0 :hour '*)
- :allow-now-p t)
- :name "YIT" :thread t))
- ;; Start getUpdates thread
- (bordeaux-threads:make-thread
- (lambda () (loop-with-error-backoff #'process-updates))
- :name "process-updates"))
|