|
|
@@ -149,7 +149,7 @@
|
|
|
(send-akb (format-akb post))
|
|
|
(setf *akb-last-id* id)
|
|
|
(save-settings))))
|
|
|
- (error (e) (log:error e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
(defun send-akb (text)
|
|
|
(log:info "send-akb: ~A" text)
|
|
|
@@ -157,7 +157,7 @@
|
|
|
(handler-case
|
|
|
(telegram-send-message chat-id text
|
|
|
:disable-web-preview 1)
|
|
|
- (error (e) (log:error e)))))
|
|
|
+ (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)
|
|
|
@@ -174,7 +174,7 @@
|
|
|
:disable-web-preview 1)
|
|
|
(error (e) (log:error e))))))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id "Ошибочка вышла"))))
|
|
|
|
|
|
;; Finance
|
|
|
@@ -185,7 +185,7 @@
|
|
|
(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 e))))
|
|
|
+ (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)
|
|
|
@@ -226,7 +226,7 @@
|
|
|
(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 e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id "Хуйня какая-то"))))
|
|
|
|
|
|
;; Weather
|
|
|
@@ -243,7 +243,7 @@
|
|
|
:hourly (find "hourly" args :key #'string-downcase :test #'equal)
|
|
|
:daily (find "daily" args :key #'string-downcase :test #'equal)))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
"Ошибочка вышла"))
|
|
|
"Так а ты чьих будешь?"))))
|
|
|
|
|
|
@@ -286,7 +286,7 @@
|
|
|
(telegram-send-message chat-id (format nil "Теперь палим ~A" username)))))))
|
|
|
(db-fsq-set-chat-users chat-id users))))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id "Ошибочка вышла"))))
|
|
|
|
|
|
(defun handle-cmd-fsq-friends (chat-id message-id args)
|
|
|
@@ -303,7 +303,7 @@
|
|
|
(aget "id" user)
|
|
|
(member (aget "id" user) users :test #'equal)
|
|
|
(fsq-user-name user))))))
|
|
|
- (error (e) (log:error e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
|
|
|
(defun handle-cmd-checkins (chat-id message-id args)
|
|
|
@@ -317,7 +317,7 @@
|
|
|
(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 e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
|
|
|
(defun process-latest-checkins ()
|
|
|
@@ -336,7 +336,7 @@
|
|
|
(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 e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
|
|
|
;; RSS
|
|
|
@@ -351,7 +351,7 @@
|
|
|
(find-rss-links (car args))))
|
|
|
:disable-web-preview 1)
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id "Ошибочка вышла"))))
|
|
|
|
|
|
(defun %send-feeds (chat-id feeds)
|
|
|
@@ -399,13 +399,12 @@
|
|
|
(if existing
|
|
|
(setf feeds (remove existing feeds))
|
|
|
(push feed feeds)))))
|
|
|
- (error (e) (log:error e))))
|
|
|
- (log:info 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)))))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
- (telegram-send-message chat-id "Ошибочка вышла"))))
|
|
|
+ (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)
|
|
|
@@ -422,7 +421,7 @@
|
|
|
:parse-mode "Markdown"
|
|
|
:disable-web-preview 1))))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id "Ошибочка вышла"))))
|
|
|
|
|
|
(defun process-feeds ()
|
|
|
@@ -436,7 +435,7 @@
|
|
|
:parse-mode "Markdown"
|
|
|
:disable-web-preview 1)))
|
|
|
(db-rss-update-feed feed)) ;; Update next fetch and period
|
|
|
- (error (e) (log:error e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
;; VK walls
|
|
|
(defun %send-domains (chat-id domains)
|
|
|
@@ -468,8 +467,19 @@
|
|
|
collect (cons (parse-integer (subseq k 6)) v))))
|
|
|
(cdr (assoc (apply #'max (mapcar #'car sizes)) sizes)))))
|
|
|
|
|
|
-(defun %vk-find-picture (attachments)
|
|
|
- (%vk-find-best-photo (find "photo" attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
|
|
|
+(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")
|
|
|
|
|
|
@@ -487,13 +497,13 @@
|
|
|
(cl-ppcre:regex-replace-all +vk-link-scanner+
|
|
|
(aget "text" post)
|
|
|
"[\\3](https://vk.com/\\1)")
|
|
|
- (%vk-find-picture (aget "attachments" post))
|
|
|
+ (%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"
|
|
|
+ (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)
|
|
|
@@ -516,10 +526,10 @@
|
|
|
(if existing
|
|
|
(db-vk-remove-chat-domain chat-id domain)
|
|
|
(db-vk-add-chat-domain chat-id domain))))
|
|
|
- (error (e) (log:error e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
(%send-domains chat-id (db-vk-get-chat-domains chat-id)))))
|
|
|
(error (e)
|
|
|
- (log:error e)
|
|
|
+ (log:error "~A" e)
|
|
|
(telegram-send-message chat-id (format nil "Ошибочка вышла: ~A" e)))))
|
|
|
|
|
|
(defun process-walls ()
|
|
|
@@ -546,12 +556,12 @@
|
|
|
:parse-mode "Markdown"
|
|
|
:disable-web-preview disable))))
|
|
|
(setf last-id (max last-id (aget "id" post)))))
|
|
|
- (error (e) (log:error e)))
|
|
|
+ (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 e))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
|
|
|
(defvar *save-settings-lock* (bordeaux-threads:make-lock "save-settings-lock")
|
|
|
@@ -601,6 +611,18 @@
|
|
|
: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))
|
