From 1a714ac77afe71222bb432e733bbc9dc6d9baefb Mon Sep 17 00:00:00 2001 From: eriedaberrie Date: Thu, 7 Nov 2024 15:19:59 -0800 Subject: [PATCH] feat!: sync-music: properly utilize cuesheets Instead of blindly copying over .cue files, attempt to parse them with cuetools and use the data to split up the associated flac files. Old behavior is available under --dumb-cue-copy. --- nix/sync-music.nix | 7 ++- sync-music.asd | 1 + sync-music/actions.lisp | 29 +++++++--- sync-music/main.lisp | 5 ++ sync-music/package.lisp | 1 + sync-music/sync-music.lisp | 113 ++++++++++++++++++++++++++++++++++--- sync-music/utils.lisp | 28 +++++++++ 7 files changed, 164 insertions(+), 20 deletions(-) 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.