chad-music/back/rym.lisp

(in-package :cl-user)
(defpackage chad-music.rym
  (:use :cl #:alexandria #:chad-music.utils)
  (:export #:custom-chart
           #:load-all))
(in-package :chad-music.rym)

(defvar *cookies* (cl-cookie:make-cookie-jar) "rateyourmusic.com valid cookies")
(defparameter +rym-charts-url+ "https://rateyourmusic.com/customchart")
(defparameter +ua+ "Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:58.0) Gecko/20100101 Firefox/58.0")

(defun custom-chart (&key
                       (chart-type :top)
                       (countries)
                       (genre-include t)
                       (genres)
                       (include :both)
                       (include-child-genres t)
                       (origin-countries nil)
                       (page 1)
                       (type :album)
                       (year :alltime))
  (let* ((parameters
          `(("chart_type" . ,(dekeyify chart-type))
            ("countries" . ,(or countries ""))
            ("genre_include" . ,(if genre-include "1" "0"))
            ("genres" . ,(format nil "~{~A~^,~}" genres))
            ("include" . ,(dekeyify include))
            ("include_child_genres" . ,(if include-child-genres "1" "0"))
            ("include_child_genres_chk" . ,(if include-child-genres "1" ""))
            ("origin_countries" . ,(format nil "~{~A~^,~}" origin-countries))
            ("page" . ,(write-to-string page))
            ("type" . ,(dekeyify type))
            ("year" . ,(etypecase year
                                  (integer (write-to-string year))
                                  (symbol (dekeyify year))
                                  (string year)))))
         (dom (xml-request +rym-charts-url+
                           :parameters parameters
                           :cookie-jar *cookies*
                           :user-agent +ua+)))
    (loop for tr across (clss:select "#content table tr" dom)
       when (select-text tr ".artist")
       collect
         (list :chart-year year
               :chart-pos (parse-integer (select-text tr ".ooookiig"))
               :artist (select-text tr ".artist")
               :album (select-text tr ".album")
               :year (let ((text (select-text tr ".chart_year")))
                       (when text
                         (parse-integer (subseq text 1 (1- (length text))) :junk-allowed t)))
               :genres (map 'list #'select-text (clss:select ".genre" tr))
               :stats  (map 'list #'select-text (clss:select ".chart_stats b" tr))))))

(defvar *dull-genres* '("television music" "video game music" "film score" "film soundtrack"))

(defun scrape-charts (filename &key (max-year 2017) (min-year 1950) (max-page 3) (min-page 1))
  (with-output-to-file (s filename :if-exists :append)
    (loop for page from min-page upto max-page
       do (loop for year from max-year downto min-year
             do (progn
                  (loop for item in (custom-chart :genre-include nil
                                                  :genres *dull-genres*
                                                  :year year
                                                  :page page)
                     do (print item s))
                  (print (cons year page))
                  (sleep 5))))))

(defun load-all (filename &optional if-does-not-exist)
  (with-input-from-file (s filename :if-does-not-exist if-does-not-exist)
    (loop for value = (read s nil)
       while value
       collect value)))

(defun range (field min &optional (max 3000))
  (lambda (c)
    (let ((value (getf c field)))
      (<= min value max))))

(defun getter (field)
  (lambda (c)
    (getf c field)))

(defstruct ordered artist albums genres score)
(defun ordered-print (instance &optional stream)
  (with-slots (artist albums genres score) instance
    (format stream "Artist: ~A~%Genres: ~{~A~^, ~}~%Albums: ~{~A~^, ~}~%Score: ~A~%~%"
            artist genres albums score)))
(defun order-artists (charts)
  (let ((ht (make-hash-table :test 'equal)))
    (loop for c in charts
       for artist = (getf c :artist)
       do (multiple-value-bind (item foundp)
              (gethash artist ht)
            (unless foundp
              (setf item (make-ordered :artist artist :score 0)
                    (gethash artist ht) item))
            (pushnew (getf c :album) (ordered-albums item) :test 'equal)
            (dolist (genre (getf c :genres))
              (pushnew genre (ordered-genres item) :test 'equal))
            (incf (ordered-score item)
                  (ceiling (- 121 (getf c :chart-pos)) 12))))
    (sort (hash-table-values ht) #'> :key 'ordered-score)))

(defun set-cookie (name value path domain)
  (cl-cookie:merge-cookies
   *cookies*
   (list
    (cl-cookie:make-cookie :name name
                           :value value
                           :path path
                           :domain domain))))

(defun infohash-magnet (info-hash)
  (concatenate 'string "magnet:?xt=urn:btih:" info-hash))

(defvar *deluge-api* "http://10.8.77.1:8112/json")
(defvar *deluge-password* "deluge")
(defvar *deluge-request-id* 1)
(defun deluge-request (method &optional params is-auth)
  (let* ((content (trivial-utf-8:string-to-utf-8-bytes
                  (jojo:to-json `(:|id| ,(incf *deluge-request-id*)
                                   :|method| ,method
                                   :|params| ,params))))
         (response (json-request *deluge-api* :method :post
                                 :content content
                                 :cookie-jar *cookies*))
         (error-message (getf (getf response :|error|) :|message|)))
    (if error-message
      (if (and (null is-auth)
               (equal error-message "Not authenticated"))
          (progn
            (deluge-auth)
            (deluge-request method params t)) ;; Retry original request
          (error error-message))
      (getf response :|result|))))
(defun deluge-auth ()
  (deluge-request "auth.login" (list *deluge-password*) t))
(defun deluge-add-info-hash (info-hashes)
  (unless (listp info-hashes)
    (setf info-hashes (list info-hashes)))
  (let ((torrents (loop for ih in info-hashes
                     collect (list :|path| (infohash-magnet ih)
                                   :|options| '(:|add_paused| :true)))))
    (deluge-request "web.add_torrents" (list torrents))))

(defun deluge-get-torrents ()
  (deluge-request "core.get_session_state"))

(defun deluge-get-torrents-status (filter fields)
  (deluge-request "core.get_torrents_status" (list filter fields)))

(defparameter +deluge-default-status-fields+ '("files" "file_priorities" "save_path"))
(defun deluge-get-torrent-files (info-hash)
  (let* ((status (deluge-request "core.get_torrent_status" (list info-hash +deluge-default-status-fields+)))
         (save-path (getf status :|save_path|)))
    (loop for file in (getf status :|files|)
       for prio in (getf status :|file_priorities|)
       do (setf (getf file :|prio|) prio
                (getf file :|path|) (format nil "~A/~A" save-path (getf file :|path|)))
       collect file)))

(defun deluge-get-seeding-torrents ()
  (loop for (torrent state) on (deluge-get-torrents-status '(:|state| "Seeding") '("name")) by #'cddr
     collect (cons (string torrent) (getf state :|name|))))

(defun deluge-pause-torrents (&rest torrents)
  (deluge-request "core.pause_torrent" (list torrents)))

(defun raw-pathname (pathspec)
  (values (cl-ppcre:regex-replace-all "\\[" pathspec "\\\\[")))

(defun deluge-delete-skipped (torrent &optional dry)
  (let* ((status (deluge-request "core.get_torrent_status" (list torrent +deluge-default-status-fields+)))
         (save-path (getf status :|save_path|)))
    (loop for file in (getf status :|files|)
       for prio in (getf status :|file_priorities|)
       for path = (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|))))
       when (zerop prio)
       when (probe-file path)
       do (if dry (format t "Deleting '~A'~%" path)
              (uiop:delete-file-if-exists path)))))

(defun deluge-process-downloaded (&optional dry)
  (loop for (ih . name) in (deluge-get-seeding-torrents)
     do (progn
          (format t "Processing '~a'~%" name)
          (deluge-pause-torrents ih)
          (deluge-delete-skipped ih dry))))

(defun deluge-save-rm-list (filename)
  (let ((torrents (deluge-get-torrents)))
    (with-output-to-file (s filename)
      (dolist (torrent torrents)
        (let* ((status (deluge-request "core.get_torrent_status" (list torrent +deluge-default-status-fields+)))
               (save-path (getf status :|save_path|)))
          (loop
             for file in (getf status :|files|)
             for prio in (getf status :|file_priorities|)
             when (zerop prio)
             do (format s "~A/~A~%" save-path (getf file :|path|))))))))

(defparameter +rutracker-search+ "https://rutracker.org/forum/tracker.php")
(defun search-artist (artist &optional (suffix "дискография"))
  (http-request +rutracker-search+ :parameters `(("nm" . ,(format nil "~A~@[ ~A~]" artist suffix)))))

;;; rutracker sqlite dump
(defvar *rt-db* nil)
(defun rt-connect (path)
  (setf *rt-db* (sqlite:connect path)))
(defun rt-select (sql &rest parameters)
  (apply #'sqlite:execute-to-list *rt-db* sql parameters))

(defun rt-artist (artist)
  (rt-select "select title, hash_info from torrent where title like ? and title like '%искография%' and not title like '%lossless%' order by size_b desc limit 30" (format nil "%~A%" artist)))

(defun save-rt (filename artists)
  (with-output-to-file (s filename :if-exists :append :if-does-not-exist :create)
    (loop for artist in artists
       do (print artist)
       do (loop for result in (rt-artist artist)
             do (print (cons artist result) s)))))

(defun select-torrent (torrents)
  (format t "   Select torrent:~%~{~A) ~A~%~}0) Skip~%s) Stop~%~%Enter: "
          (loop for i from 1 for tor in torrents append (list i (car tor))))
  (let ((answer (read)))
    (typecase answer
      (integer (if (zerop answer) nil
                   (or (nth (1- answer) torrents)
                       (select-torrent torrents))))
      (symbol :stop))))

(defun rt-find-artists (charts-filename found-filename)
  (let ((found (load-all found-filename :create))
        (ordered (order-artists (load-all charts-filename))))
    (with-output-to-file (s found-filename :if-exists :append :if-does-not-exist :create)
      (dolist (item ordered)
        (let ((artist (ordered-artist item)))
          (unless (member artist found :test 'equal :key 'car)
            (ordered-print item t)
            (let ((torrents (rt-artist artist)))
              (if torrents
                  (let ((torrent (select-torrent torrents)))
                    (when (eq torrent :stop)
                      (return))
                    (when torrent (deluge-add-info-hash (cdr torrent)))
                    (print (cons artist torrent) s))
                  (print (cons artist nil) s)))))))))