aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-10-25 09:34:58 -0500
committerColin Okay <colin@cicadas.surf>2022-10-25 09:34:58 -0500
commita47d4afe8f58b509a19af137191f7dbe7172b4c1 (patch)
tree3d1cb7954d6fe8d842059372a1fcdfd8c9fbf792
parent233153fe50477647f17ba94991dc4ef1444afacc (diff)
Add: download and play tracks
-rw-r--r--downloader.lisp63
-rw-r--r--vampire.lisp119
2 files changed, 76 insertions, 106 deletions
diff --git a/downloader.lisp b/downloader.lisp
index 246bf29..3142277 100644
--- a/downloader.lisp
+++ b/downloader.lisp
@@ -2,23 +2,26 @@
(in-package #:vampire)
-(defvar *dl-cluster*
- nil)
+(defvar *dl-cluster*)
+(defvar *media-directory*)
-(defun start-downloader-service (&key (count 5))
- (setf *dl-cluster* (or *dl-cluster* (legion:make-cluster count 'run-job)))
+(defun start-downloader-service (config)
+ (let ((media-dir
+ (merge-pathnames "media/" (static-directory config))))
+ (ensure-directories-exist media-dir)
+ (setf *dl-cluster* (legion:make-cluster (downloader-threads config)
+ (lambda (job) (funcall job media-dir)))))
(legion:start *dl-cluster*))
-(defun run-job (thunk)
- (funcall thunk))
-
(defun add-fetch-track-job (url ok err)
+ "URL is a url to some audio track. OK is a function that accepts a
+ TRACK instance. ERR is a function accepting an error condition"
(legion:add-job
*dl-cluster*
- (lambda ()
- (if-let (track (download-media url))
- (funcall ok track)
- (funcall err url)))))
+ (lambda (media-dir)
+ (handler-case
+ (funcall ok (download-media url media-dir))
+ (error (e) (funcall err e))))))
(defun trackinfo-file (dir name)
(merge-pathnames
@@ -53,22 +56,24 @@
:duration dur
:thumb-url url))))
-(defun download-media (url)
+(defun download-media (url media-dir)
+ "Download media and create a new track from its audio source, moving
+ the raw audio to the media-dir when done."
(with-temp-dir (tmpdir)
- (handler-case
- (let* ((tmpname
- (default-name "media"))
- (trackinfo-file
- (trackinfo-file 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)
- (let ((info
- (trackinfo trackinfo-file)))
- (new-track
- (trackmedia-file tmpdir)
- info))))
- (error (e)
- (format t "ERROR: ~a~%" e)
- nil))))
+ (let* ((tmpname
+ (default-name "media"))
+ (trackinfo-file
+ (trackinfo-file tmpdir tmpname)))
+ (uiop:run-program
+ (format nil "youtube-dl --write-info-json -x -o \"~a/~a.%(ext)s\" ~a"
+ tmpdir tmpname url))
+ (let* ((info
+ (trackinfo trackinfo-file))
+ (downloaded
+ (trackmedia-file tmpdir))
+ (file
+ (merge-pathnames (format nil "~a.~a"
+ (nuid) (pathname-type downloaded))
+ media-dir)))
+ (uiop:copy-file downloaded file)
+ (new-track file info)))))
diff --git a/vampire.lisp b/vampire.lisp
index 03b8830..e7ce96d 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -28,13 +28,16 @@
(defclass/bknr playlist (keyed)
((title :with :std (default-name "playlist"))
(tracks editors :with :std (list))
- (cover :with :std nil :doc "A url to the cover of this album.")
+ (cover-image :with :std nil :doc "A url to the cover of this album.")
(user :with
:std (error "A USER is required to have created the content."))))
-(defclass/bknr track (bknr.datastore:blob keyed)
- ((source title artist album thumb-url duration codec :with)
- (playlists :std (list) :doc "A list of playlists in which this track appears")))
+(defmethod initialize-instance :after ((pl playlist) &key)
+ (pushnew pl (user-playlists (playlist-user pl)) :test #'eq))
+
+(defclass/bknr track (keyed)
+ ((source file title artist album thumb-url duration codec :with)
+ (playlists :with :std (list) :doc "A list of playlists in which this track appears")))
(defclass/bknr user (keyed)
((name :with :std "")
@@ -43,12 +46,6 @@
;;; RESOURCE ACCESS OPERATIONS
-(defun make-playlist (user &key (title (default-name "playlist")))
- (make-instance 'playlist :user user :title title))
-
-(defun track-with-source (source &key (test 'string-equal))
- (find source (store-objects-with-class 'track) :test test :key 'track-source))
-
(defun playlist-duration (pl)
(reduce #'+
(playlist-tracks pl)
@@ -65,48 +62,6 @@
(setf (playlist-tracks pl) newlist
(track-playlists track) (delete pl (track-playlists track)
:test #'eq :count 1))))
-
-
-(defun add-editor (playlist user)
- (pushnew user (playlist-editors playlist) :test #'eq))
-
-(defun remove-editor (playlist user)
- (setf (playlist-editors playlist)
- (delete user (playlist-editors playlist) :test #'eq)))
-
-(defgeneric can-edit-p (thing user))
-
-(defmethod can-edit-p ((pl playlist) user)
- (or
- (eq user (content-user user))
- (member user (playlist-editors pl) :test #'eq)))
-
-(defmethod can-edit-p ((tr track) user)
- (loop for pl in (track-playlists tr)
- thereis (can-edit-p pl user)))
-
-(defun delete-track (tr)
- "Deletes a track and ensures it is removed from playlists that
- include it."
- (loop for pl in (track-playlists tr)
- do (setf (playlist-tracks pl)
- (delete tr (playlist-tracks pl) :test #'eq)))
- (bknr.datastore:delete-object tr))
-
-(defun delete-playlist (pl)
- (loop for tr in (playlist-tracks pl)
- do (remove-track-from-list )
-
- do (setf (track-playlists tr) (delete pl (track-playlists tr))))
- (bknr.datastore:delete-object pl))
-
-(defun ownerp (user content)
- (eq user (content-user content)))
-
-(defun set-owner (user &rest contents)
- (dolist (content contents)
- (setf (content-user content) user)))
-
;;; TRANSACTIONS
(defun append-track (pl tr)
@@ -119,16 +74,14 @@
(defun new-playlist (user &key title)
(with-transaction ()
- (push (make-playlist user :title title)
- (user-playlists user))))
+ (make-instance 'playlist :title title :user user)))
(defun new-track (file trackinfo)
"Trackinfo is a plist containing information about the track to create."
(with-transaction ()
- (apply #'bknr.datastore:make-blob-from-file
- file
- 'track
- trackinfo)))
+ (let ((track (apply #'make-instance 'track trackinfo)))
+ (setf (track-file track) (namestring file))
+ track)))
;;; CLIENT
@@ -178,19 +131,28 @@
(setf (url (location (connection-body parent)))
url)))))))
+(defun media-url-path (track)
+ (format nil "/media/~a.~a"
+ (pathname-name (track-file track))
+ (pathname-type (track-file track))))
+
+(create-audio )
+
(defun create-track-listing (parent playlist &rest args)
(declare (ignorable args))
(dolist (track (playlist-tracks playlist))
(with-clog-create parent
- (div ()
+ (div (:bind view)
(section (:h4 :content (track-title track)))
(img (:bind thumb))
- (audio (:source :bind audio))
- (p (:content "|>")))
+ (audio (:source (media-url-path track) :controls nil :bind audio)))
+ (set-on-click
+ view
+ (alambda
+ (play-media audio)))
(if (track-thumb-url track)
(setf (url-src thumb) (track-thumb-url track)
- (height thumb) "100px")
- (setf ( ))))))
+ (height thumb) "100px")))))
(defun create-track-form (parent playlist &rest args)
(declare (ignorable args))
@@ -211,15 +173,17 @@
(notice
(create-p notice-area :content (format nil "... Fetching ~a" url))))
(setf (value url-input) "")
- (if-let (track (download-media url))
- (progn
- (append-track playlist track)
- (reload (location (connection-body parent))))
- (progn
- (alert (window (connection-body parent))
- (format nil "Error while fetching track at: ~%~a"
- url))))
- (remove-from-dom notice))))))
+ (add-fetch-track-job
+ url
+ (lambda (track)
+ (append-track playlist track)
+ (reload (location (connection-body parent))))
+ (lambda (err)
+ (remove-from-dom notice)
+ (format t "Error: ~a~%" err)
+ (alert (window (connection-body parent))
+ (format nil "Error whiel fetching track at: ~a~%"
+ url)))))))))
(defun playlist-page (body)
(when-let* ((listid
@@ -268,14 +232,15 @@
(make-instance
'bknr.datastore:mp-store
:directory (datastore-directory config)
- :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem)
- (make-instance 'bknr.datastore:blob-subsystem))))
+ :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem))))
(defun start (config)
(setf *config* config)
(initialize-database config )
- (start-downloader-service)
- (initialize 'main)
+ (start-downloader-service config)
+ (initialize 'main
+ :extended-routing t
+ :static-root (static-directory config))
(set-on-new-window 'user-page :path "/user")
(set-on-new-window 'login-page :path "/login")
(set-on-new-window 'playlist-page :path "/playlist")
@@ -284,5 +249,5 @@
(defun hacking-start ()
(start (make-instance
'config
- :media-directory (merge-pathnames "vampire-media/" (user-homedir-pathname))
+ :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname))
:datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))))