Show errors

chatikbot.lisp

@@ -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))

db.lisp

@@ -8,7 +8,7 @@
                     (asdf:find-system '#:chatikbot))))
 
 (defmacro with-db ((db) &body body)
-  `(sqlite:with-open-database (,db (db-path) :busy-timeout 10)
+  `(sqlite:with-open-database (,db (db-path) :busy-timeout 30)
      (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
      ,@body))