Find feeds cmd

chatikbot.lisp

@@ -72,6 +72,7 @@
               (: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))
               (otherwise (handle-admin-cmd chat-id text cmd args))))
           (send-dont-understand chat-id (preprocess-input text))))
     (when location
@@ -340,7 +341,8 @@
 (defun %get-feed (url)
   (when url
     (or (find url *rss-feeds* :key #'feed-url :test #'equal)
-        (let ((feed (build-feed url)))
+        (alexandria:when-let (feed (build-feed url))
+          (log:info "Added feed" feed)
           (fetch-new-items feed)
           (push feed *rss-feeds*)
           feed))))
@@ -354,6 +356,20 @@
   (setf *rss-feeds*
         (remove-if-not #'%used-feed-p *rss-feeds*)))
 
+(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)
+    (error (e)
+      (log:error e)
+      (telegram-send-message chat-id "Ошибочка вышла"))))
+
 (defun handle-cmd-rss (chat-id message-id args)
   (log:info "handle-cmd-rss" chat-id message-id args)
   (handler-case
@@ -362,7 +378,9 @@
             (%send-feeds chat-id feeds)
             (progn
               (dolist (url args)
-                (alexandria:when-let ((feed (%get-feed (find-rss-url url))))
+                (alexandria:when-let (feed (%get-feed
+                                            (or (cadar (find-rss-links url))
+                                                url)))
                   (if (member feed feeds)
                       (setf feeds (remove feed feeds))
                       (push feed feeds))))

rss.lisp

@@ -19,30 +19,29 @@
   (nreverse (plump:get-elements-by-tag-name node tag)))
 
 (defun url-parse (url)
-  (plump:parse (flexi-streams:octets-to-string
-                (drakma:http-request (http-default url) :force-binary t) :external-format :utf-8)))
-
-(defun find-rss-url (url)
+  (multiple-value-bind (body status headers uri stream)
+      (drakma:http-request (http-default url) :force-binary t)
+    (declare (ignore status headers stream))
+    (values
+     (plump:parse (flexi-streams:octets-to-string body :external-format :utf-8))
+     uri)))
+
+(defun find-rss-links (url)
   (handler-case
-    (multiple-value-bind (body status headers uri stream)
-        (drakma:http-request (http-default url) :force-binary t)
-      (declare (ignore status stream))
-      (let ((root (plump:parse (flexi-streams:octets-to-string body :external-format :utf-8)))
-            (content-type (aget :content-type headers)))
-        (cond
-          ((alexandria:starts-with-subseq "text/html" content-type)
-           (loop for link in (get-by-tag root "link")
-              when (string= "application/rss+xml" (plump:attribute link "type"))
-              do (return (puri:render-uri
-                          (puri:merge-uris (puri:uri (plump:attribute link "href"))
-                                           uri) nil))))
-          ((string= "rss" (plump:tag-name (plump:first-element root)))
-           (puri:render-uri uri nil)))))
+      (multiple-value-bind (root uri) (url-parse url)
+        (loop for link in (get-by-tag root "link")
+           when (string= "application/rss+xml" (plump:attribute link "type"))
+           collect (list (plump:attribute link "title")
+                         (puri:render-uri
+                          (puri:merge-uris
+                           (puri:uri (plump:attribute link "href"))
+                           uri) nil))))
     (error (e) (log:error e))))
 
 (defun build-feed (url)
   (let ((root (url-parse url)))
-    (make-feed :url url :title (child-text root "title"))))
+    (alexandria:when-let (rss (car (get-by-tag root "rss")))
+      (make-feed :url url :title (child-text rss "title")))))
 
 (defun adjust-period (feed coeff)
   "Adjust the period of feed based on whenever there were new items. With clamping"