83 lines
3.4 KiB
Common Lisp
83 lines
3.4 KiB
Common Lisp
|
(in-package #:sync-music)
|
||
|
|
|
||
|
|
(defstruct action
|
||
|
|
(target nil :type pathname))
|
||
|
|
(defstruct (copy-action (:include action))
|
||
|
|
(origin nil :type pathname))
|
||
|
|
(defstruct (copy-flac-action (:include copy-action)))
|
||
|
|
(defstruct (copy-meta-action (:include copy-action)))
|
||
|
|
(defstruct (delete-action (:include action)))
|
||
|
|
(defstruct (directory-action (:include action)))
|
||
|
|
|
||
|
|
(defgeneric action-describe (action &optional s)
|
||
|
|
(:documentation "Format to stream S a single line describing ACTION in brief."))
|
||
|
|
(defgeneric action-perform (action &optional queue)
|
||
|
|
(:documentation "Perform ACTION.
|
||
|
|
|
||
|
|
Pushes status message about this action to QUEUE if given."))
|
||
|
|
(defgeneric action-perform-describe (action)
|
||
|
|
(:documentation "Status message, as printed during ACTION-PERFORM."))
|
||
|
|
|
||
|
|
(defmethod action-describe ((a copy-action) &optional s)
|
||
|
|
(format s "[C] ~A -> ~A~%" (copy-action-origin a) (action-target a)))
|
||
|
|
(defmethod action-describe ((a delete-action) &optional s)
|
||
|
|
(format s "[D] ~A~%" (action-target a)))
|
||
|
|
(defmethod action-describe ((a directory-action) &optional s)
|
||
|
|
(format s "[M] ~A~%" (action-target a)))
|
||
|
|
|
||
|
|
(defmethod action-perform ((a copy-action) &optional queue)
|
||
|
|
(declare (ignore queue))
|
||
|
|
(uiop:copy-file (copy-action-origin a) (action-target a)))
|
||
|
|
|
||
|
|
(defmethod action-perform ((a copy-flac-action) &optional queue)
|
||
|
|
(declare (ignore queue))
|
||
|
|
(uiop:run-program (list "ffmpeg" "-n"
|
||
|
|
"-filter_threads" "1"
|
||
|
|
"-i" (uiop:native-namestring (copy-action-origin a))
|
||
|
|
"-c:a" "libopus"
|
||
|
|
"-map" "0:a"
|
||
|
|
"-b:a" *opus-bitrate*
|
||
|
|
(uiop:native-namestring (action-target a)))))
|
||
|
|
|
||
|
|
(defmethod action-perform ((a copy-meta-action) &optional queue)
|
||
|
|
(declare (ignore queue))
|
||
|
|
(let (buf)
|
||
|
|
(with-open-file (input
|
||
|
|
(copy-action-origin a)
|
||
|
|
:element-type 'octet)
|
||
|
|
(setf buf (make-array (file-length input) :element-type 'octet))
|
||
|
|
(read-sequence buf input))
|
||
|
|
(setf buf (replace-text-buffer buf ".flac" ".opus"))
|
||
|
|
(with-open-file (output
|
||
|
|
(action-target a)
|
||
|
|
:element-type 'octet
|
||
|
|
:direction :output)
|
||
|
|
(write-sequence buf output))))
|
||
|
|
|
||
|
|
(defmethod action-perform ((a delete-action) &optional queue)
|
||
|
|
(declare (ignore queue))
|
||
|
|
(delete-file (action-target a)))
|
||
|
|
|
||
|
|
(defmethod action-perform ((a directory-action) &optional queue)
|
||
|
|
(declare (ignore queue))
|
||
|
|
(ensure-directories-exist (action-target a)))
|
||
|
|
|
||
|
|
(defmethod action-perform :before ((a action) &optional queue)
|
||
|
|
(when queue
|
||
|
|
(lparallel.queue:push-queue (action-perform-describe a) queue)))
|
||
|
|
|
||
|
|
(defmethod action-perform-describe ((a copy-action))
|
||
|
|
(format nil "Copying ~A to ~A..." (copy-action-origin a) (action-target a)))
|
||
|
|
(defmethod action-perform-describe ((a copy-meta-action))
|
||
|
|
(format nil "Modifying ~A to ~A..." (copy-action-origin a) (action-target a)))
|
||
|
|
(defmethod action-perform-describe ((a copy-flac-action))
|
||
|
|
(format nil "Converting ~A to ~A..." (copy-action-origin a) (action-target a)))
|
||
|
|
(defmethod action-perform-describe ((a delete-action))
|
||
|
|
(format nil "Deleting ~A..." (action-target a)))
|
||
|
|
(defmethod action-perform-describe ((a directory-action))
|
||
|
|
(format nil "Ensuring ~A exists..." (action-target a)))
|
||
|
|
|
||
|
|
;; NOTE: delete actions are equal to copy actions to the same target
|
||
|
|
(defmethod fset:compare ((a1 action) (a2 action))
|
||
|
|
(fset:compare-slots a1 a2 #'action-target))
|