(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)))))))))