chatikbot/plugins/tescort.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.tescort
  (:use :cl :chatikbot.common :chatikbot.scraping))
(in-package :chatikbot.plugins.tescort)

(defparameter +login-form+
  '(("http://www.tescort.com/private/signin")
    ".signin-box form"
    (("username" . login)
     ("password" . pass))))

(defparameter +blacklist-search+
  '(("http://www.tescort.com/panel/client-blacklist" :parameters (("client_criterias" . q)
                                                                  ("search" . "search")))
    ".black_list_table tbody tr"
    ((:date . ("td:nth-of-type(1)"))
     (:name . ("td:nth-of-type(2)"))
     (:city . ("td:nth-of-type(3)"))
     (:phone . ("td:nth-of-type(4)"))
     (:comment . ("td:nth-of-type(5)")))))

(defvar *login*)
(defvar *pass*)
(defun login ()
  (let ((dom (do-form +login-form+ `((login . ,*login*) (pass . ,*pass*)))))
    (when (zerop (length (clss:select "#header .sitemenu-logged" dom)))
      (error "bad password"))
    dom))

(defvar *tescort-cookie-jar* (cl-cookie:make-cookie-jar))
(defun search-blacklist (query)
  (let ((*cookie-jar* *tescort-cookie-jar*))
    (unless (have-cookies (car +blacklist-search+))
      (login))
    (scrape-list +blacklist-search+ `((q . ,query)))))

(defun format-blacklist (blacklist)
  (with-output-to-string (s)
    (loop for item in blacklist
       do (format s "~A, ~A: ~A *~A*~%~A~%~%"
                  (agets item :date) (agets item :city)
                  (agets item :name) (agets item :phone)
                  (agets item :comment)))))

(defun handle-blacklist (chat-id query)
  (telegram-send-chat-action chat-id "typing")
  (let ((results (search-blacklist query)))
    (bot-send-message chat-id (if results (format-blacklist results) "Not found")
                      :parse-mode "markdown" :disable-web-preview "true")))

(def-message-cmd-handler handler-cmd-blacklist (:blacklist)
  (cond
    ((null args) (bot-send-message chat-id "Enter query")
     (on-next-message chat-id
       (handle-blacklist chat-id text)))
    (:otherwise (handle-blacklist chat-id (spaced args)))))