aboutsummaryrefslogtreecommitdiffhomepage
path: root/downloader.lisp
blob: 5f7077a9b92f3d5c83e426e8b05866ffb16a6a42 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
;;;; downloader.lisp

(in-package #:vampire)

(defvar *dl-cluster*
  nil)

(defun start-downloader-service (&key (count 5))
  (setf *dl-cluster* (or *dl-cluster* (legion:make-cluster count 'run-job)))
  (legion:start *dl-cluster*))

(defun run-job (thunk)
  (funcall thunk))

(defun add-fetch-track-job (url ok err)
  (legion:add-job
   *dl-cluster*
   (lambda ()
     (if-let (track (download-media url))
       (funcall ok track)
       (funcall err url)))))

(defun info-file-with-name (dir name)
  (merge-pathnames
   (format nil "~a.info.json" name)
   dir))

(defun trackinfo (path)
  "Returns a trackinfo object - a list whose first member is a path to
   a file and whose CDR is a PLIST of attributes to pass
   to (make-instance 'track ...)"
  (with-plist ((title :|title|)
               (album :|album|)
               (codec :|acodec|)
               (artist :|artist|)
               (dur :|duration|)
               (file :|filename|)
               (thumbs :|thumbnails|)
               (source :|webpage_url|))
      (jonathan:parse (alexandria:read-file-into-string path))
    (with-plist ((url :|url|)) (first thumbs)
      (cons file 
            (list
             :source source
             :title title
             :album album
             :codec codec
             :artist artist
             :duration dur
             :thumb-url url)))))

(defun download-media (url)
  (with-temp-dir (tmpdir)
    (let* ((tmpname
             (default-name "media"))
           (trackinfo-file
             (info-file-with-name tmpdir tmpname)))
      (uiop:run-program 
       (format nil "youtube-dl --write-info-json -x -o \"~a/~a.%(ext)s\" ~a"
               tmpdir tmpname url))
      (when (uiop:file-exists-p trackinfo-file)
        (new-track (trackinfo trackinfo-file))))))