eriedaberrie/lisp-scripts
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat!: sync-music: use libcue instead of cuetools

Browse source
This commit is contained in:
eriedaberrie 2024-11-11 18:34:27 -08:00
parent f0e61b33fd
commit 527620d2ea
10 changed files with 437 additions and 114 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
flake.nix
View file

@ -35,6 +35,8 @@
devShells = forSystems (
pkgs: {
default = pkgs.mkShell rec {
inputsFrom = builtins.attrValues self.packages.${pkgs.stdenv.system};
nativeBuildInputs =
[
(pkgs.sbcl.withPackages (lib.const
@ -42,7 +44,12 @@
]
++ lib.concatMap (p: p.runtimeInputs or []) inputsFrom;
inputsFrom = builtins.attrValues self.packages.${pkgs.stdenv.system};
LD_LIBRARY_PATH = let
getNativeLibs = d:
d.nativeLibs
or []
++ builtins.concatMap getNativeLibs (d.lispLibs or []);
in lib.makeLibraryPath (lib.lists.unique (builtins.concatMap getNativeLibs inputsFrom));
};
}
);

17
nix/sync-music.nix
View file

@ -2,7 +2,7 @@
sbcl,
lib,
writeText,
cuetools,
libcue,
ffmpeg-headless,
makeWrapper,
}: let
@ -14,11 +14,14 @@
lispLibs = with sbcl.pkgs; [
alexandria
babel
cffi
cffi-grovel
cl-ppcre
fset
lparallel
pathname-utils
serapeum
trivial-features
uax-15
unix-opts
];
@ -27,8 +30,15 @@
makeWrapper
];
nativeLibs = [
(libcue.overrideAttrs {
cmakeFlags = [
(lib.cmakeBool "BUILD_SHARED_LIBS" true)
];
})
];
runtimeInputs = [
cuetools
ffmpeg-headless
];
@ -51,7 +61,8 @@
postFixup = ''
wrapProgram $out/bin/sync-music \
--prefix PATH : ${lib.makeBinPath runtimeInputs}
--prefix PATH : ${lib.makeBinPath runtimeInputs} \
--prefix LD_LIBRARY_PATH : $LD_LIBRARY_PATH
'';
meta.mainProgram = "sync-music";

12
sync-music.asd
View file

@ -1,11 +1,19 @@
(asdf:defsystem sync-music
:pathname #P"sync-music/"
:defsystem-depends-on (#:cffi-grovel
#:trivial-features)
:components ((:file "package")
(:file "utils" :depends-on ("package"))
(:file "actions" :depends-on ("package"))
(:file "sync-music" :depends-on ("package" "utils")))
(:file "actions" :depends-on ("package" "utils"))
(:file "sync-music" :depends-on ("package" "utils" "libcue"))
(:module "libcue"
:depends-on ("package")
:components ((:cffi-grovel-file "grovel")
(:file "ffi")
(:file "libcue" :depends-on ("grovel" "ffi")))))
:depends-on (#:alexandria
#:babel
#:cffi
#:cl-ppcre
#:fset
#:lparallel

10
sync-music/actions.lisp
View file

@ -5,8 +5,8 @@
(defstruct (copy-action (:include action))
(origin nil :type pathname))
(defstruct (copy-flac-action (:include copy-action))
(start nil :type (or string null))
(end nil :type (or string null))
(start nil :type (or integer null))
(length nil :type (or integer null))
(metadata nil :type (soft-alist-of string string)))
(defstruct (copy-meta-action (:include copy-action)))
(defstruct (delete-action (:include action)))
@ -39,9 +39,9 @@ Pushes status message about this action to QUEUE if given."))
"-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)))
`("-ss" ,(ffmpeg-timestamp start)))
,@(when-let ((length (copy-flac-action-length a)))
`("-t" ,(ffmpeg-timestamp length)))
,@(loop :for (tag . value) :in (copy-flac-action-metadata a)
:collect "-metadata"
:collect (format nil "~A=~A" tag value))

85
sync-music/libcue/ffi.lisp Normal file
View file

@ -0,0 +1,85 @@
(in-package #:sync-music/libcue-ffi)
(defctype file-ptr :pointer)
(defcfun (fopen "fopen") file-ptr
(str :string)
(mode :string))
(defcfun (fclose "fclose") :int
(file file-ptr))
#+unix
(cl:progn
(defcfun (freopen "freopen") file-ptr
(str :string)
(mode :string)
(stream file-ptr))
(defcfun (dup "dup") :int
(old-fd :int)))
(define-foreign-library libcue
(:unix (:or "libcue.so.2.3.0" "libcue.so"))
(t (:default "libcue")))
(use-foreign-library libcue)
(defctype cd-ptr :pointer)
(defctype track-ptr :pointer)
(defctype cd-text-ptr :pointer)
(defctype rem-ptr :pointer)
(defcfun (cue-parse-file "cue_parse_file") cd-ptr
(file file-ptr))
(defcfun (cue-parse-string "cue_parse_string") cd-ptr
(str :string))
(defcfun (cd-delete "cd_delete") :void
(cd cd-ptr))
(defcfun (%cd-get-mode "cd_get_mode") :int
(cd cd-ptr))
(defcfun (cd-get-cd-text-file "cd_get_cdtextfile") :string
(cd cd-ptr))
(defcfun (cd-get-track-count "cd_get_ntrack") :int
(cd cd-ptr))
(defcfun (cd-get-cd-text "cd_get_cdtext") cd-text-ptr
(cd cd-ptr))
(defcfun (track-get-cd-text "track_get_cdtext") cd-text-ptr
(track track-ptr))
(defcfun (cd-text-get "cdtext_get") :string
(pti :int)
(cd-text cd-text-ptr))
(defcfun (cd-get-rem "cd_get_rem") rem-ptr
(cd cd-ptr))
(defcfun (track-get-rem "track_get_rem") rem-ptr
(track track-ptr))
(defcfun (rem-get "rem_get") :string
;; NOTE: Defined in libcue.h as unsigned int, but actually takes in enum
(rem-type :int)
(rem rem-ptr))
(defcfun (cd-get-track "cd_get_track") track-ptr
(cd cd-ptr)
(i :int))
(defcfun (track-get-file-name "track_get_filename") :string
(track track-ptr))
(defcfun (track-get-start "track_get_start") :long
(track track-ptr))
(defcfun (track-get-length "track_get_length") :long
(track track-ptr))
(defcfun (%track-get-mode "track_get_mode") :int
(track track-ptr))
(defcfun (%track-get-sub-mode "track_get_sub_mode") :int
(track track-ptr))
(defcfun (%track-flag-set-p "track_is_set_flag") :boolean
(track track-ptr)
(flag :int))
(defcfun (track-get-zero-pre "track_get_zero_pre") :long
(track track-ptr))
(defcfun (track-get-zero-post "track_get_zero_post") :long
(track track-ptr))
(defcfun (track-get-isrc "track_get_isrc") :string
(track track-ptr))
(defcfun (track-get-index "track_get_index") :long
(track track-ptr)
(i :int))

77
sync-music/libcue/grovel.lisp Normal file
View file

@ -0,0 +1,77 @@
(in-package #:sync-music/libcue-ffi)
#+unix
(progn
(include "stdio.h")
(cvar ("stderr" +stderr+) :pointer
:read-only t)
(include "unistd.h")
(constant (+stderr-fileno+ "STDERR_FILENO"))
(include "errno.h")
(cvar ("errno" +errno+) :int
:read-only t))
(include "libcue.h")
(cenum disc-mode
((:da "MODE_CD_DA"))
((:rom "MODE_CD_ROM"))
((:rom-xa "MODE_CD_ROM_XA")))
(cenum track-mode
((:audio "MODE_AUDIO"))
((:mode-1 "MODE_MODE1"))
((:mode-1-raw "MODE_MODE1_RAW"))
((:mode-2 "MODE_MODE2"))
((:mode-2-form-1 "MODE_MODE2_FORM1"))
((:mode-2-form-2 "MODE_MODE2_FORM2"))
((:mode-2-form-mix "MODE_MODE2_FORM_MIX"))
((:mode-2-raw "MODE_MODE2_RAW")))
(cenum track-sub-mode
((:rw "SUB_MODE_RW"))
((:rw-raw "SUB_MODE_RW_RAW")))
(cenum track-flag
((:none "FLAG_NONE"))
((:pre-emphasis "FLAG_PRE_EMPHASIS"))
((:copy-permitted "FLAG_COPY_PERMITTED"))
((:data "FLAG_DATA"))
((:four-channel "FLAG_FOUR_CHANNEL"))
((:scms "FLAG_SCMS"))
((:any "FLAG_ANY")))
(cenum data-type
((:audio "DATA_AUDIO"))
((:data "DATA_DATA"))
((:fifo "DATA_FIFO"))
((:zero "DATA_ZERO")))
(cenum pti
((:title "PTI_TITLE"))
((:performer "PTI_PERFORMER"))
((:songwriter "PTI_SONGWRITER"))
((:composer "PTI_COMPOSER"))
((:arranger "PTI_ARRANGER"))
((:message "PTI_MESSAGE"))
((:disc-id "PTI_DISC_ID"))
((:genre "PTI_GENRE"))
((:toc-info-1 "PTI_TOC_INFO1"))
((:toc-info-2 "PTI_TOC_INFO2"))
((:reserved-1 "PTI_RESERVED1"))
((:reserved-2 "PTI_RESERVED2"))
((:reserved-3 "PTI_RESERVED3"))
((:reserved-4 "PTI_RESERVED4"))
((:upc-isrc "PTI_UPC_ISRC"))
((:size-info "PTI_SIZE_INFO"))
((:end "PTI_END")))
(cenum rem-type
((:date "REM_DATE"))
((:album-gain "REM_REPLAYGAIN_ALBUM_GAIN"))
((:album-peak "REM_REPLAYGAIN_ALBUM_PEAK"))
((:track-gain "REM_REPLAYGAIN_TRACK_GAIN"))
((:track-peak "REM_REPLAYGAIN_TRACK_PEAK"))
((:end "REM_END")))

79
sync-music/libcue/libcue.lisp Normal file
View file

@ -0,0 +1,79 @@
(in-package #:sync-music/libcue)
(defmacro with-read-file ((var path) &body body)
"Bind VAR to the result of an fopen on PATH while executing BODY."
(once-only (path)
`(let ((,var (fopen (uiop:native-namestring ,path) "r")))
(declare (dynamic-extent ,var))
(when (cffi:null-pointer-p ,var)
(error "Failed to open file `~A` with errno ~A." ,path +errno+))
(unwind-protect
(progn ,@body)
(fclose ,var)))))
(defmacro with-ignore-stderr (&body body)
"Execute BODY without printing anything into stderr.
Only works on Unix systems with a /dev/fd/ filesystem."
#+unix
(with-gensyms (old-stderr)
`(progn
(finish-output *error-output*)
(let ((,old-stderr (dup +stderr-fileno+)))
(prog1
(progn
(freopen "/dev/null" "w" +stderr+)
,@body)
(freopen (format nil "/dev/fd/~D" ,old-stderr) "a" +stderr+)))))
#-unix
`(progn ,@body))
(defmacro with-cue ((var type data) &body body)
"Bind VAR to the result of a cue_parse_* while executing BODY.
If TYPE is :FILE, use cue_parse_file with fopen on DATA. If TYPE is :STRING,
use cue_parse_string directly."
(once-only (data)
`(let ((,var ,(ecase type
(:file
(with-gensyms (file)
`(with-read-file (,file ,data)
(with-ignore-stderr
(cue-parse-file ,file)))))
(:string
data))))
(declare (dynamic-extent ,var))
(unless (cffi:null-pointer-p ,var)
(unwind-protect
(progn ,@body)
(cd-delete ,var))))))
(defun get-rem (type data)
(rem-get (cffi:foreign-enum-value 'rem-type type) data))
(defun get-cd-text (type data)
(cd-text-get (cffi:foreign-enum-value 'pti type) data))
(defun cd-get-mode (cd)
(cffi:foreign-enum-keyword 'disc-mode
(%cd-get-mode cd)))
(defun track-get-mode (track)
(cffi:foreign-enum-keyword 'track-mode
(%track-get-mode track)))
(defun track-get-sub-mode (track)
(cffi:foreign-enum-keyword 'track-sub-mode
(%track-get-sub-mode track)))
(defun track-flag-set-p (track flag)
(%track-flag-set-p track
(cffi:foreign-enum-keyword 'track-flag flag)))
(defun ensure-nonempty (val)
"Ensure a null value returned by a libcue function is NIL."
(unless (etypecase val
(null t)
(string (emptyp val))
(integer (minusp val)))
val))

68
sync-music/package.lisp
View file

@ -1,6 +1,72 @@
(uiop:define-package #:sync-music/libcue-ffi
(:use #:cffi)
(:export #+unix #:+stderr+
#+unix #:+stderr-fileno+
#+unix #:+errno+
#:disc-mode
#:track-mode
#:track-sub-mode
#:track-flag
#:data-type
#:pti
#:rem-type
#:fopen
#:fclose
#+unix #:freopen
#+unix #:dup
#:cue-parse-file
#:cue-parse-string
#:cd-delete
#:%cd-get-mode
#:cd-get-cd-text-file
#:cd-get-track-count
#:cd-get-cd-text
#:track-get-cd-text
#:cd-text-get
#:cd-get-rem
#:track-get-rem
#:rem-get
#:cd-get-track
#:track-get-file-name
#:track-get-start
#:track-get-length
#:%track-get-mode
#:%track-get-sub-mode
#:%track-flag-set-p
#:track-get-zero-pre
#:track-get-zero-post
#:track-get-isrc
#:track-get-index))
(uiop:define-package #:sync-music/libcue
(:use #:cl #:alexandria #:serapeum #:sync-music/libcue-ffi)
(:export #:with-cue
#:get-rem
#:get-cd-text
#:cd-get-mode
#:track-get-mode
#:track-get-sub-mode
#:track-flag-set-p
#:cd-get-cd-text-file
#:cd-get-track-count
#:cd-get-cd-text
#:track-get-cd-text
#:cd-get-rem
#:track-get-rem
#:cd-get-track
#:track-get-file-name
#:track-get-start
#:track-get-length
#:track-get-zero-pre
#:track-get-zero-post
#:track-get-isrc
#:track-get-index
#:ensure-nonempty))
(uiop:define-package #:sync-music
(:use #:cl #:alexandria #:serapeum)
(:local-nicknames (#:p-utils #:org.shirakumo.pathname-utils))
(:local-nicknames (#:p-utils #:org.shirakumo.pathname-utils)
(#:libcue #:sync-music/libcue))
(:export #:*worker-threads*
#:*opus-bitrate*
#:*max-depth*

142
sync-music/sync-music.lisp
View file

@ -1,9 +1,10 @@
(in-package #:sync-music)
(defun make-file-copy-action (origin target &optional (test #'string-equal))
"Create subclass of COPY-ACTION based on the filetype of ORIGIN and TEST for equality.
"Create subclass of COPY-ACTION based on the filetype of ORIGIN.
Return the action if it exists, or NIL if the file should not be copied."
Use TEST for file extension 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
@ -23,94 +24,89 @@ Return the action if it exists, or NIL if the file should not be copied."
: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)
"Return all cue-based copy actions from ORIGIN to TARGET if applicable.
ORIGIN-FILES is just a list of all files in ORIGIN. Use TEST for file
extension equality."
(when-let ((cue-file (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
:ignore-error-status t)
:junk-allowed t)))
(when (> cue-track-count (count-if (lambda (f)
(libcue:with-cue (cd :file cue-file)
(let ((track-count (libcue:cd-get-track-count cd)))
(when (> 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))
(loop :with actions := (fset:empty-set)
:with track-count-str := (format nil "~2,'0D" track-count)
:with cd-rem := (libcue:cd-get-rem cd)
:with cd-cd-text := (libcue:cd-get-cd-text cd)
:with album-date := (libcue:ensure-nonempty
(libcue:get-rem :date cd-rem))
:with album-title := (libcue:get-cd-text :title cd-cd-text)
:with album-artist := (libcue:ensure-nonempty
(libcue:get-cd-text :performer cd-cd-text))
:with album-composer := (libcue:ensure-nonempty
(libcue:get-cd-text :composer cd-cd-text))
:with album-genre := (libcue:ensure-nonempty
(libcue:get-cd-text :genre cd-cd-text))
:for track-number :from 1 :upto track-count
:for track-number-str := (format nil "~2,'0D" track-number)
:for track := (libcue:cd-get-track cd track-number)
:for track-rem := (libcue:track-get-rem track)
:for track-cd-text := (libcue:track-get-cd-text track)
:for track-date := (or (libcue:ensure-nonempty
(libcue:get-rem :date track-rem))
album-date)
:for track-title := (libcue:get-cd-text :title track-cd-text)
:for track-artist := (or (libcue:ensure-nonempty
(libcue:get-cd-text :performer track-cd-text))
album-artist)
:for track-composer := (or (libcue:ensure-nonempty
(libcue:get-cd-text :composer track-cd-text))
album-composer)
:for track-genre := (or (libcue:ensure-nonempty
(libcue:get-cd-text :genre track-cd-text))
album-genre)
:for origin-file-name := (let* ((raw-file (libcue:track-get-file-name track))
(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 := (ppcre:regex-replace-all *invalid-char-scanner*
(format nil
:for metadata := (let ((metadata))
(flet ((add-metadata (field value)
(when value
(push (cons field value) metadata))))
(add-metadata "ALBUM" album-title)
(add-metadata "TRACKTOTAL" track-count-str)
(add-metadata "ALBUMARTIST" album-artist)
(add-metadata "TITLE" track-title)
(add-metadata "TRACKNUMBER" track-number-str)
(add-metadata "ARTIST" track-artist)
(add-metadata "COMPOSER" track-composer)
(add-metadata "GENRE" track-genre)
(add-metadata "DATE" track-date))
metadata)
:for output-file-name := (format nil
"~A - ~A"
track-number
track-title)
"!!!")
track-number-str
(ppcre:regex-replace-all
*invalid-char-scanner*
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)
:start (libcue:ensure-nonempty
(libcue:track-get-start track))
:length (libcue:ensure-nonempty
(libcue:track-get-length track))
:metadata metadata)
: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)))))
:finally (return actions)))))))
(defun get-all-copy-actions (origin target &optional (depth 0))
"Recursively iterate ORIGIN for files to copy.

18
sync-music/utils.lisp
View file

@ -18,9 +18,6 @@
(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.")
(defparameter *invalid-char-scanner* (ppcre:create-scanner "[\"*/:<>?\\\\|]")
"Scan for any characters not allowed in an Android/NTFS file name.")
@ -46,16 +43,13 @@
,(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)))
(defun ffmpeg-timestamp (frames)
"Convert time in CD frames to ffmpeg duration H:MM:SS.m."
(let ((hours 0)
(minutes 0)
(seconds 0)
(millis (round (* frames 1000) 75)))
(handle-overflow (millis 1000) (seconds 60) (minutes))
(handle-overflow (minutes 60) (hours))
(handle-overflow (millis 1000) (seconds 60) (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)