diff options
| -rw-r--r-- | downloader.lisp | 63 | ||||
| -rw-r--r-- | vampire.lisp | 119 |
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))))) |