diff options
| -rw-r--r-- | playlist.lisp | 16 | ||||
| -rw-r--r-- | utilities.lisp | 5 | ||||
| -rw-r--r-- | vampire.lisp | 1 | ||||
| -rw-r--r-- | zipper.lisp | 32 |
4 files changed, 17 insertions, 37 deletions
diff --git a/playlist.lisp b/playlist.lisp index b52a0a7..e320906 100644 --- a/playlist.lisp +++ b/playlist.lisp @@ -448,21 +448,19 @@ (editor-managment (pl))))) (set-on-click zip-download-button (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)))))) + (zip-playlist pl) + (setf (pl-zip ctl) (make-zipped-playlist-link pl body)) + (place-after zip-download-button (pl-zip ctl)))) (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") + (when (zipped-playlist-exists-p pl) + (setf (pl-zip ctl) (make-zipped-playlist-link pl body)) + (place-after zip-download-button (pl-zip ctl))) + (when (playlist-editors pl) (setf (inner-html collaborators-elem) (with-output-to-string (out) diff --git a/utilities.lisp b/utilities.lisp index 0e258b6..a7e90e4 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -128,5 +128,6 @@ (apply then args) (apply else args)))) -(defun clean-slashes (str) - (cl-ppcre:regex-replace-all "/" str "-")) +(defun clean-filename (str) + (let ((non-safe-chars (cl-ppcre:create-scanner "[^a-zA-Z0-9_\\-.]"))) + (cl-ppcre:regex-replace-all non-safe-chars str "-"))) diff --git a/vampire.lisp b/vampire.lisp index 4470917..a45b853 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -47,7 +47,6 @@ (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 f83989f..0271159 100644 --- a/zipper.lisp +++ b/zipper.lisp @@ -2,24 +2,6 @@ (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." (unless (zipped-playlist-exists-p playlist) @@ -32,12 +14,11 @@ (defun zip-track-filename (track pos) "Return a filename for a track. `NN-ARTIST-ALBUM-TITLE.CODEC'" (with-slots (artist album title codec) track - (format nil "~2,'0d-~a-~a-~a.~a" pos - (clean-slashes artist) (clean-slashes album) (clean-slashes title) codec))) + (clean-filename (format nil "~2,'0d-~a-~a-~a.~a" pos artist album title codec)))) (defun zipped-playlist-filename (playlist) "Return a url-safe zip filename for a playlist." - (concatenate 'string (clean-slashes (playlist-title playlist)) ".zip")) + (concatenate 'string (clean-filename (playlist-title playlist)) ".zip")) (defun zipped-playlist-path (playlist) "Returns the zipped playlist path relative to the configured static directory." @@ -65,7 +46,8 @@ (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." - (print "Deleting zipped playlist") - (uiop:delete-file-if-exists (zipped-playlist-path (playlist playlist-ctl))) - (destroy (pl-zip playlist-ctl))) + "Deletes the zipped playlist file and removes the associated link element. +Returns T if it was deleted, NIL otherwise." + (when (uiop:delete-file-if-exists (zipped-playlist-path (playlist playlist-ctl))) + (unless (null (pl-zip playlist-ctl)) + (destroy (pl-zip playlist-ctl))))) |