diff --git a/nix/sync-music.nix b/nix/sync-music.nix index 376620c..037a2e1 100644 --- a/nix/sync-music.nix +++ b/nix/sync-music.nix @@ -2,7 +2,8 @@ sbcl, lib, writeText, - ffmpeg, + cuetools, + ffmpeg-headless, makeWrapper, }: let sync-music = sbcl.buildASDFSystem rec { @@ -13,6 +14,7 @@ lispLibs = with sbcl.pkgs; [ alexandria babel + cl-ppcre fset lparallel pathname-utils @@ -26,7 +28,8 @@ ]; runtimeInputs = [ - ffmpeg + cuetools + ffmpeg-headless ]; buildScript = writeText "build-sync-music.lisp" '' diff --git a/sync-music.asd b/sync-music.asd index 9275ba1..b8afd29 100644 --- a/sync-music.asd +++ b/sync-music.asd @@ -6,6 +6,7 @@ (:file "sync-music" :depends-on ("package" "utils"))) :depends-on (#:alexandria #:babel + #:cl-ppcre #:fset #:lparallel #:pathname-utils diff --git a/sync-music/actions.lisp b/sync-music/actions.lisp index 0109337..62c46dd 100644 --- a/sync-music/actions.lisp +++ b/sync-music/actions.lisp @@ -4,7 +4,10 @@ (target nil :type pathname)) (defstruct (copy-action (:include action)) (origin nil :type pathname)) -(defstruct (copy-flac-action (:include copy-action))) +(defstruct (copy-flac-action (:include copy-action)) + (start nil :type (or string null)) + (end nil :type (or string null)) + (metadata nil :type (soft-alist-of string string))) (defstruct (copy-meta-action (:include copy-action))) (defstruct (delete-action (:include action))) (defstruct (directory-action (:include action))) @@ -31,14 +34,22 @@ Pushes status message about this action to QUEUE if given.")) (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" - "-ac" "2" - "-b:a" *opus-bitrate* - (uiop:native-namestring (action-target a))))) + (uiop:run-program + `("ffmpeg" "-n" + "-filter_threads" "1" + "-i" ,(uiop:native-namestring (copy-action-origin a)) + ,@(when-let ((start (copy-flac-action-start a))) + `("-ss" ,(convert-timestamp start))) + ,@(when-let ((end (copy-flac-action-end a))) + `("-to" ,(convert-timestamp end))) + ,@(loop :for (tag . value) :in (copy-flac-action-metadata a) + :collect "-metadata" + :collect (format nil "~A=~A" tag value)) + "-c:a" "libopus" + "-map" "0:a" + "-ac" "2" + "-b:a" ,*opus-bitrate* + ,(uiop:native-namestring (action-target a))))) (defmethod action-perform ((a copy-meta-action) &optional queue) (declare (ignore queue)) diff --git a/sync-music/main.lisp b/sync-music/main.lisp index d3aa0c3..0bc0947 100644 --- a/sync-music/main.lisp +++ b/sync-music/main.lisp @@ -29,6 +29,10 @@ :long "depth" :arg-parser #'parse-integer :meta-var "MAX-DEPTH") + (:name :dumb-cue-copy-p + :description "blindly copy cue files instead of parsing them" + :short #\c + :long "dumb-cue-copy") (:name :dry-run-p :description "print out actions and exit" :short #\n @@ -85,6 +89,7 @@ *opus-bitrate*)) (*max-depth* (or (getf options :max-depth) *max-depth*)) + (*dumb-cue-copy-p* (getf options :dumb-cue-copy-p)) (*dry-run-p* (getf options :dry-run-p)) (*cleanupp* (not (getf options :no-cleanup-p))) (*ignore-toplevel-p* (not (getf options :no-ignore-toplevel-p)))) diff --git a/sync-music/package.lisp b/sync-music/package.lisp index c0ef5a6..c2ec7b4 100644 --- a/sync-music/package.lisp +++ b/sync-music/package.lisp @@ -6,6 +6,7 @@ #:*max-depth* #:*cleanupp* #:*ignore-toplevel-p* + #:*dumb-cue-copy-p* #:*general-extensions* #:*meta-extensions* #:*action-perform-output* diff --git a/sync-music/sync-music.lisp b/sync-music/sync-music.lisp index 663bdb4..f385a60 100644 --- a/sync-music/sync-music.lisp +++ b/sync-music/sync-music.lisp @@ -1,23 +1,114 @@ (in-package #:sync-music) (defun make-file-copy-action (origin target &optional (test #'string-equal)) - "Create the correct subclass of COPY-ACTION based on the file extension of ORIGIN. + "Create subclass of COPY-ACTION based on the filetype of ORIGIN and TEST for equality. Return the action if it exists, or NIL if the file should not be copied." (when-let* ((type (pathname-type origin)) (make-action-fn (cond - ((funcall test type "flac") (setf type "opus") #'make-copy-flac-action) - ((member type *meta-extensions* :test test) #'make-copy-meta-action) - ((member type *general-extensions* :test test) #'make-copy-action)))) + ((funcall test type "flac") + (setf type "opus") + #'make-copy-flac-action) + ((and *dumb-cue-copy-p* + (member type *meta-extensions* :test test)) + #'make-copy-meta-action) + ((member type *general-extensions* :test test) + #'make-copy-action)))) (funcall make-action-fn :origin origin :target (pathname-normalize-unicode - (make-pathname :directory (pathname-directory target) - :name (pathname-name origin) + (make-pathname :name (pathname-name origin) :type type :defaults target))))) +(defun get-cue-copy-actions (origin origin-files target &optional (test #'string-equal)) + (when-let* ((cue-file (uiop:native-namestring + (find-if (lambda (f) + (funcall test (pathname-type f) "cue")) + origin-files))) + (cue-track-count (parse-integer + (uiop:run-program (list "cueprint" + "-d" "%N" + cue-file) + :output :string) + :junk-allowed t))) + (when (> cue-track-count (count-if (lambda (f) + (funcall test (pathname-type f) "flac")) + origin-files)) + (loop :repeat cue-track-count + :with actions := (fset:empty-set) + :with album-data-raw := (uiop:run-program + (list "cueprint" + "-d" "%T\\n%02N\\n%P" + cue-file) + :output :lines) + :with track-data-raw := (uiop:run-program + (list "cueprint" + "-t" "%f\\n%t\\n%02n\\n%p\\n%c\\n%g\\n" + cue-file) + :output :lines) + :with break-start-data-raw := (uiop:run-program + (list "cuebreakpoints" + "--append-gaps" + cue-file) + :output :lines) + :with break-end-data-raw := (uiop:run-program + (list "cuebreakpoints" + "--prepend-gaps" + cue-file) + :output :lines) + ;; HACK: Determine if track 1 has pregap based on breakpoint count + :with track-1-pregap-p := (< (length break-start-data-raw) + (length break-end-data-raw)) + :for origin-file-name := (let* ((raw-file (pop track-data-raw)) + (dot (position #\. raw-file :from-end t))) + (subseq raw-file 0 dot)) + :for origin-file := (make-pathname :name origin-file-name + :type "flac" + :defaults origin) + :for track-title := (first track-data-raw) + :for track-number := (second track-data-raw) + :for data-raw := (append album-data-raw + (loop :repeat 5 + :collect (pop track-data-raw))) + :for metadata := (mapcar #'cons + '("ALBUM" + "TRACKTOTAL" + "ALBUMARTIST" + "TITLE" + "TRACKNUMBER" + "ARTIST" + "COMPOSER" + "GENRE") + data-raw) + :for metadata-filtered := (delete-if (compose #'emptyp #'cdr) metadata) + :for previous-action := nil :then current-action + :for output-file-name := (substitute #\! #\/ (format nil + "~A - ~A" + track-number + track-title)) + :for current-action := (make-copy-flac-action + :origin origin-file + :target (pathname-normalize-unicode + (make-pathname :name output-file-name + :type "opus" + :defaults target)) + :metadata metadata-filtered) + :do (fset:adjoinf actions current-action) + :with previous-file + :do (cond + ((equal previous-file origin-file-name) + (setf (copy-flac-action-start current-action) (pop break-start-data-raw)) + (setf (copy-flac-action-end previous-action) (pop break-end-data-raw))) + (t + (unless (uiop:file-exists-p origin-file) + (return)) + (when track-1-pregap-p + (setf (copy-flac-action-start current-action) (pop break-end-data-raw))) + (setf previous-file origin-file-name))) + :finally (return actions))))) + (defun get-all-copy-actions (origin target &optional (depth 0)) "Recursively iterate ORIGIN for files to copy. @@ -27,9 +118,13 @@ actions that need performing in order to store the targets as second value." (let ((files (fset:empty-set)) (directories (fset:empty-set))) (unless (and *ignore-toplevel-p* (= depth 1)) - (dolist (file (uiop:directory-files origin)) - (when-let ((action (make-file-copy-action file target))) - (fset:adjoinf files action)))) + (let ((origin-files (uiop:directory-files origin))) + (if-let ((cue-copy-actions (and (not *dumb-cue-copy-p*) + (get-cue-copy-actions origin origin-files target)))) + (fset:unionf files cue-copy-actions) + (dolist (file (uiop:directory-files origin)) + (when-let ((action (make-file-copy-action file target))) + (fset:adjoinf files action)))))) (dolist (directory (uiop:subdirectories origin)) (let ((target-directory (make-pathname :directory (append (pathname-directory target) diff --git a/sync-music/utils.lisp b/sync-music/utils.lisp index 47716c3..19d3b63 100644 --- a/sync-music/utils.lisp +++ b/sync-music/utils.lisp @@ -10,12 +10,17 @@ "Whether to perform remove actions and delete empty folders.") (defvar *ignore-toplevel-p* t "Whether to ignore files at the top level.") +(defvar *dumb-cue-copy-p* nil + "Whether to blindly copy cue files rather than parse them.") (defparameter *general-extensions* '("mp3" "ogg" "opus") "General file extensions that should be copied over.") (defparameter *meta-extensions* '("cue" "m3u" "m3u8") "File extensions where *.flac text needs to be replaced.") +(defparameter *timestamp-scanner* (ppcre:create-scanner "^(\\d+):(\\d{2})\\.(\\d{2})$") + "Scan for a cuetools position.") + (defun maybe-normalize-unicode (s) (if (stringp s) (uax-15:normalize s :nfc) s)) @@ -27,6 +32,29 @@ :type (maybe-normalize-unicode (pathname-type p)) :defaults p)) +(defmacro handle-overflow ((unit unit-max) (next-unit &optional next-max) &rest args) + "Handle integer overflow from UNIT with maximum UNIT-MAX into NEXT-UNIT." + (with-gensyms (div rem) + `(when (>= ,unit ,unit-max) + (multiple-value-bind (,div ,rem) + (floor ,unit ,unit-max) + (setf ,unit ,rem) + (incf ,next-unit ,div)) + ,(when next-max + `(handle-overflow (,next-unit ,next-max) ,@args))))) + +(defun convert-timestamp (s) + "Convert cuetools position MM:SS.FF to ffmpeg duration MM:SS.m." + (let* ((all-times (nth-value 1 (ppcre:scan-to-strings *timestamp-scanner* s))) + (hours 0) + (minutes (parse-integer (aref all-times 0))) + (seconds (parse-integer (aref all-times 1))) + (frames (parse-integer (aref all-times 2))) + (millis (round (* frames 1000) 75))) + (handle-overflow (millis 1000) (seconds 60) (minutes)) + (handle-overflow (minutes 60) (hours)) + (format nil "~D:~2,'0D:~2,'0D.~3,'0D" hours minutes seconds millis))) + (defun vector-nconc-extend (v1 v2 &key (start 0) end) "Like vector-append-extend, but using another vector.