|
|
@@ -460,39 +460,36 @@
|
|
|
(db-vk-ensure-domain domain last-id)
|
|
|
domain))
|
|
|
|
|
|
-(defun %vk-find-best-photo (photo)
|
|
|
- (let ((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-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 %format-attachment (item)
|
|
|
- (cond
|
|
|
- ((equal "photo" (aget "type" item))
|
|
|
- (%vk-find-best-photo (aget "photo" item)))))
|
|
|
+(defun %vk-find-picture (attachments)
|
|
|
+ (%vk-find-best-photo (find "photo" attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
|
|
|
|
|
|
(defparameter +vk-link-scanner+ (cl-ppcre:create-scanner "\\[((id|club)\\d+)\\|([^\\]]*?)\\]") "vk linking regex")
|
|
|
-(defun %vk-format-text (text)
|
|
|
- (cl-ppcre:regex-replace-all +vk-link-scanner+ text "[\\3](https://vk.com/\\1)"))
|
|
|
|
|
|
(defun %vk-post-text (post)
|
|
|
(alexandria:when-let (reposts (aget "copy_history" post))
|
|
|
(setf post (car (last reposts))))
|
|
|
- (let ((text (%vk-format-text (aget "text" post)))
|
|
|
- (attachs (format nil "~{~A~^~%~}"
|
|
|
- (remove nil (mapcar #'%format-attachment
|
|
|
- (aget "attachments" post))))))
|
|
|
- (format nil "~{~A~^~%~}" (remove "" (list text attachs) :test #'equal))))
|
|
|
+ (values
|
|
|
+ (cl-ppcre:regex-replace-all +vk-link-scanner+
|
|
|
+ (aget "text" post)
|
|
|
+ "[\\3](https://vk.com/\\1)")
|
|
|
+ (%vk-find-picture (aget "attachments" post))))
|
|
|
|
|
|
(defun %format-wall-post (domain post)
|
|
|
- (format nil "[~A](https://vk.com/~A?w=wall~A_~A)~@[ @ _~A_~]~%~A~%"
|
|
|
- domain domain (aget "from_id" post) (aget "id" post)
|
|
|
- (alexandria:when-let (ts (local-time:unix-to-timestamp (aget "date" post)))
|
|
|
- (local-time:format-timestring
|
|
|
- nil ts
|
|
|
- :format '((:year 2) "-" (:month 2) "-" (:day 2)
|
|
|
- " " (:hour 2) ":" (:min 2))))
|
|
|
- (%vk-post-text post)))
|
|
|
+ (multiple-value-bind (text preview) (%vk-post-text post)
|
|
|
+ (values
|
|
|
+ (format nil "~@[[✅](~A)~] [~A](https://vk.com/~A?w=wall~A_~A)~@[ @ ~A~]~%~A"
|
|
|
+ preview domain domain (aget "from_id" post) (aget "id" post)
|
|
|
+ (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)
|
|
|
@@ -532,10 +529,11 @@
|
|
|
(dolist (post new-posts)
|
|
|
(dolist (chat-id (db-vk-get-domain-chats domain))
|
|
|
(ignore-errors
|
|
|
- (telegram-send-message chat-id
|
|
|
- (%format-wall-post domain post)
|
|
|
- :parse-mode "Markdown"
|
|
|
- :disable-web-preview 1)))
|
|
|
+ (multiple-value-bind (text disable) (%format-wall-post domain post)
|
|
|
+ (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 e)))
|
|
|
(db-vk-update-wall domain last-id
|
