chatikbot/plugins/tescort.lisp

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

(defvar *chat-cookie-jars* (make-hash-table))

(defparameter +blacklists+
  '((:tescort
     (:scrape (:request . ("http://www.tescort.com/panel/client-blacklist"
                           :parameters (("client_criterias" . q)
                                        ("search" . "search"))))
      (:items . ".black_list_table tbody tr")
      (:info (: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)"))
             (:photos . ("td:nth-of-type(5) a" :attr :href :multiple t))))
     (:init . (("http://www.tescort.com/private/signin")
               ".signin-box form"
               (("username" . tescort-login)
                ("password" . tescort-pass))))
     (:validate . "#header .sitemenu-logged"))
    (:annonce
     (:scrape (:request . ("https://www.6annonce.com/private-v2/client-blacklist"
                           :parameters (("client_criterias" . q)
                                        ("search" . "search"))))
      (:items . ".black_list_table tbody tr")
      (:info (: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)"))
             (:photos . ("td:nth-of-type(5) a" :attr :href :multiple t))))
     (:init . (("https://www.6annonce.com/private/signin")
               ".signin-box form"
               (("username" . annonce-login)
                ("password" . annonce-pass))))
     (:validate . "#header .sitemenu-logged"))
    (:escortnews
     (:scrape (:request . ("https://my.escortnews.eu/ajax.php"
                           :method :post
                           :content (("s" . q)
                                     ("action" . "viewBlacklistRecords")
                                     ("page" . "1") ("s1" . "date") ("s2" . "0") ("m" . "0"))))
      (:processor . en-request)
      (:items . ".blacklist .record")
      (:info (:date . ("ul li:nth-of-type(1)"))
             (:name . ("ul li:nth-of-type(2)"))
             (:phone . ("ul li:nth-of-type(3)"))
             (:city . ("ul li:nth-of-type(4)"))
             (:email . ("ul li:nth-of-type(5)"))
             (:comment . (".text" :child 6))))
     (:init . (("https://my.escortnews.eu/")
               "#form_PopUp"
               (("username" . escortnews-login)
                ("password" . escortnews-pass))))
     (:validate-init . "button.signout")
     (:validate . ".countSearchBar"))
    ))

(defun en-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent (object-as :alist))
  (declare (ignore method parameters basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))
  (remf args :object-as)
  (when content
    (push (cons :content-type "application/json") headers))
  (multiple-value-bind (body status headers uri)
      (apply #'http-request url args)
    (unless (stringp body)
      (setf body (babel:octets-to-string body :encoding :utf-8)))
    (values (plump:parse
	     (agets
	      (or (ignore-errors (yason:parse body :object-as object-as))
		  `(("html" . ,body)))
	      "html"))
	    status headers uri)))

(defvar *tescort-login*)
(defvar *tescort-pass*)
(defvar *annonce-login*)
(defvar *annonce-pass*)
(defvar *escortnews-login*)
(defvar *escortnews-pass*)
(defun get-common-context ()
  `((tescort-login . ,*tescort-login*)
    (tescort-pass . ,*tescort-pass*)
    (annonce-login . ,*annonce-login*)
    (annonce-pass . ,*annonce-pass*)
    (escortnews-login . ,*escortnews-login*)
    (escortnews-pass . ,*escortnews-pass*)))

(defun search-blacklists (query)
  (let ((context (append (get-common-context)
                         `((q . ,query)))))
    (labels ((f (info)
               (destructuring-bind (name . params) info
                 (cons name (ignore-errors (scrape-list params context))))))
      (pmapcar #'f +blacklists+))))

(defun merge-results (results)
  (loop for (name . res) in results append res))

(defun format-blacklist (item)
  (format nil "~A, ~A: ~A *~A*~%~A~@[~%~A~]"
          (agets item :date) (agets item :city)
          (agets item :name) (agets item :phone)
          (agets item :comment)
          (when (agets item :photos)
            (format nil "~{[pic~A](~A)~^, ~}"
                    (loop for i from 1 for p in (agets item :photos)
                       append (list i p))))))

(defun handle-blacklist (query)
  (with-chat-cookies (*chat-id* *chat-cookie-jars*)
    (telegram-send-chat-action *chat-id* "typing")
    (let ((results (merge-results (search-blacklists query))))
      (bot-send-message (if results
                            (text-chunks (mapcar #'format-blacklist results)
                                         :pre-pre "" :pre-post "")
                            "Not found")
                        :parse-mode "markdown"))))

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