|
|
@@ -0,0 +1,213 @@
|
|
|
+(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* nil "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)
|
|
|
+ (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 (getf response :|error|)))
|
|
|
+ (when error (error (getf error :|message|)))
|
|
|
+ (getf response :|result|)))
|
|
|
+(defun deluge-auth ()
|
|
|
+ (deluge-request "auth.login" (list *deluge-password*)))
|
|
|
+(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| :false)))))
|
|
|
+ (deluge-request "web.add_torrents" (list torrents))))
|
|
|
+
|
|
|
+(defun deluge-get-torrents ()
|
|
|
+ (deluge-request "core.get_session_state"))
|
|
|
+
|
|
|
+(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-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)))))))))
|
