diff options
| -rw-r--r-- | playlist.lisp | 31 | ||||
| -rw-r--r-- | vampire.lisp | 1 | ||||
| -rw-r--r-- | zipper.lisp | 30 |
3 files changed, 46 insertions, 16 deletions
diff --git a/playlist.lisp b/playlist.lisp index 7a2884b..b52a0a7 100644 --- a/playlist.lisp +++ b/playlist.lisp @@ -12,8 +12,8 @@ (now-playing-track :std nil :doc "An instance of track-ctl") (np-title np-artist np-thumb np-dur np-time np-play :std nil :doc "Now Playing Elements") - (pl-title pl-tracks pl-dur - :std nil :doc "Playlist Elements") + (pl-title pl-tracks pl-dur pl-zip + :std nil :doc "Playlist Elements")) (:documentation "Holds the complete state for this session's viewing of a particular playlist.")) (defclass/std track-ctl () @@ -64,7 +64,6 @@ (setf (cur-playlist-ctl body) (make-instance 'playlist-ctl :playlist playlist - :zipped-tracks (when (zipped-playlist-exists-p playlist) (zipped-playlist-url playlist)) :editorp (can-edit-p (session-user body) playlist)))) ;;; SYNCHRONIZATION @@ -190,7 +189,7 @@ (pos (position track-ctl (tracks curctl)))) (when (delete-track-at (playlist curctl) pos) - (delete-zipped-playlist (playlist curctl)) + (delete-zipped-playlist curctl) (for-playlist-viewers container ctl (let ((track-ctl (nth pos (tracks ctl)))) (destroy (container track-ctl)) @@ -201,7 +200,7 @@ (when-let* ((curctl (cur-playlist-ctl (container track-ctl))) (pos (position track-ctl (tracks curctl)))) (when (swap-tracks (playlist curctl) pos (1+ pos)) - (delete-zipped-playlist (playlist curctl)) + (delete-zipped-playlist curctl) (for-playlist-viewers (container track-ctl) ctl (let* ((cur (nth pos (tracks ctl))) @@ -217,7 +216,7 @@ (when-let* ((curctl (cur-playlist-ctl (container track-ctl))) (pos (position track-ctl (tracks curctl)))) (when (swap-tracks (playlist curctl) pos (1- pos)) - (delete-zipped-playlist (playlist curctl)) + (delete-zipped-playlist curctl) (for-playlist-viewers (container track-ctl) ctl (let* ((cur (nth pos (tracks ctl))) @@ -351,7 +350,7 @@ (on-ok (lambda (track) (destroy notice) - (delete-zipped-playlist pl) + (delete-zipped-playlist (cur-playlist-ctl parent)) (append-track pl track) (append-track-list-item parent track)))) (setf (value url-input) "") @@ -442,17 +441,25 @@ (track-listing (pl)))) (div (:class "row") - (div () - (button (:content "Download Zipped Playlist" :bind zip-download-button))) + (div (:class "column") + (button (:content "Create Zipped Playlist" :bind zip-download-button))) (div () (new-track-form (pl)) (editor-managment (pl))))) (set-on-click zip-download-button - (thunk* (zip-playlist pl) - (setf (url (location body)) (zipped-playlist-url pl)))) + (thunk* + (add-zip-playlist-job + pl + (lambda (_) (declare (ignore _)) + (let ((zip-link (make-zipped-playlist-link pl body))) + (setf (pl-zip ctl) zip-link) + (place-after zip-download-button zip-link))) + (lambda (err) + (print (format t "~a" err)))))) (setf (pl-title ctl) title-elem (pl-dur ctl) dur-elem + ;; (inner-html download-elem) (pl-zip ctl) (display input) "none" (display title-elem) "inline") @@ -472,7 +479,7 @@ input (thunk* (when (plusp (length (value input))) - (delete-zipped-playlist pl) ;; must happen first + (delete-zipped-playlist ctl) ;; must happen first (update-playlist-title pl (value input)) (setf (text title-elem) (value input))) (setf (display input) "none" diff --git a/vampire.lisp b/vampire.lisp index a45b853..4470917 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -47,6 +47,7 @@ (setf *config* config) (initialize-database config ) (start-downloader-service config) + (start-zipper-service config) (clog:initialize 'main :port (port config) :host (host config) diff --git a/zipper.lisp b/zipper.lisp index ede4a71..f83989f 100644 --- a/zipper.lisp +++ b/zipper.lisp @@ -2,9 +2,26 @@ (in-package :vampire) +(defvar *zip-cluster*) + +(defun start-zipper-service (config) + (let ((zipped-dir (merge-pathnames "media/bundled-playlists/" (static-directory config)))) + (ensure-directories-exist zipped-dir) + (setf *zip-cluster* (legion:make-cluster (downloader-threads config) + (lambda (job) (funcall job))))) + (legion:start *zip-cluster*)) + +(defun add-zip-playlist-job (playlist ok err) + "PLAYLIST is a PLAYLIST instance. OK ... ERR ..." + (legion:add-job + *zip-cluster* + (lambda () + (handler-case + (funcall ok (zip-playlist playlist)) + (error (e) (funcall err e)))))) + (defun zip-playlist (playlist) "Compresses playlist tracks into a zip archive." - (ensure-directories-exist (merge-pathnames "media/bundled-playlists/" (static-directory *config*))) (unless (zipped-playlist-exists-p playlist) (let ((zip-file (zipped-playlist-path playlist))) (with-temp-dir (tmpdir) @@ -43,7 +60,12 @@ do (uiop:copy-file file dest) collect dest)) -(defun delete-zipped-playlist (playlist) +(defun make-zipped-playlist-link (playlist context) + (when (zipped-playlist-exists-p playlist) + (create-a context :link (zipped-playlist-url playlist) :content "Download" :target "_blank"))) + +(defun delete-zipped-playlist (playlist-ctl) "Deletes the zipped playlist file. Returns T if it was deleted, NIL otherwise." - (princ "Deleting zipped playlist") - (uiop:delete-file-if-exists (zipped-playlist-path playlist))) + (print "Deleting zipped playlist") + (uiop:delete-file-if-exists (zipped-playlist-path (playlist playlist-ctl))) + (destroy (pl-zip playlist-ctl))) |