chatikbot/plugins/tumblr.lisp

(in-package :chatikbot)

(defvar *tumblr-roll* nil "List of tumblr to select from")
(defparameter *read-timeout* 5 "API request timeout")

(defparameter *boobs-roll*
  '("http://bbt12.tumblr.com"
    "http://boobsarethegreatest.tumblr.com"
    "http://perfectbreasts.tumblr.com")
  "Tumblr roll with boobs")

(defparameter *ass-roll*
  '("http://divine-asses.tumblr.com"
    "http://greatestassonearth.tumblr.com")
  "Tumblr roll with asses")

(defparameter *tumblr-rules*
  `((((?* ?a) (?or сиськи сисяндры титьки буфера boobs tits) (?is ?n numberp))
     (#'tumblr-random-photo ,*boobs-roll* ?n))
    (((?* ?a) (?or сиськи сисяндры титьки буфера boobs tits) (?* ?b))
     (#'tumblr-random-photo ,*boobs-roll*))
    (((?* ?a) (?or жопа жопы ягодицы зад зады ass asses) (?is ?n numberp))
     (#'tumblr-random-photo ,*ass-roll* ?n))
    (((?* ?a) (?or жопа жопы ягодицы зад зады ass asses) (?* ?b))
     (#'tumblr-random-photo ,*ass-roll*))
    (((?* ?a) (?or тёлка телка телку тёлку баба бабу сука суку сучка сучку babe bitch) (?* ?b))
     (#'tumblr-random-photo ,*ass-roll*) (#'tumblr-random-photo ,*boobs-roll*))))

(defun lo-string (val)
  (string-downcase (princ-to-string val)))

(defun tumblr-read (domain &rest args)
  (handler-case
      (let ((params (loop for (k v) on args by #'cddr
                       when v collect (cons (lo-string k) (lo-string v)))))
        (yason:parse
         (subseq (flexi-streams:octets-to-string
                  (bordeaux-threads:with-timeout (*read-timeout*)
                    (drakma:http-request
                     (format nil "~A/api/read/json" domain)
                     :parameters params
                     :force-binary t))
                  :external-format :utf-8) 22)
         :object-as :alist))
    (bordeaux-threads:timeout (e) (error e))))

(defun tumblr-random-post (&key (roll *tumblr-roll*) type (num 1))
  (when roll
    (let* ((domain (random-elt roll))
           (total (aget "posts-total" (tumblr-read domain :num 1 :type type)))
           (start (random total))
           (res (tumblr-read domain :num num :type type :start start)))
      (log:info "Post" start "from" domain)
      (loop for post in (aget "posts" res)
         collect (aget "photo-url-1280" post)))))

(defun tumblr-random-photo (&optional (roll *tumblr-roll*) (num 1))
  (tumblr-random-post :roll roll :type :photo :num num))

(def-message-handler handle-tumblr (message)
  (alexandria:when-let ((resp (eliza (preprocess-input text) *tumblr-rules*)))
    (log:info resp)
    (send-response chat-id resp)))