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

feat: sync-music: copy album covers

Browse source
This commit is contained in:
eriedaberrie 2024-11-12 11:04:34 -08:00
parent 3eb4ae3b82
commit 5fc881156e
3 changed files with 37 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
sync-music/package.lisp
View file

@ -75,6 +75,8 @@
#:*dumb-cue-copy-p* #:*dumb-cue-copy-p*
#:*general-extensions* #:*general-extensions*
#:*meta-extensions* #:*meta-extensions*
#:*image-extensions*
#:*album-cover-names*
#:*action-perform-output* #:*action-perform-output*
#:action-describe #:action-describe
#:sync-music)) #:sync-music))

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

@ -110,6 +110,33 @@ extension equality."
:do (fset:adjoinf actions current-action) :do (fset:adjoinf actions current-action)
:finally (return actions))))))) :finally (return actions)))))))
(defun get-image-copy-action (origin-files target &optional (test #'string-equal))
"Determine which image file to copy from ORIGIN-FILES, if any."
(when-let ((image-files (remove-if (lambda (f)
(let ((f-type (pathname-type f)))
(notany (lambda (type)
(funcall test f-type type))
*image-extensions*)))
origin-files)))
(let ((image-file (or (find-if (lambda (f)
(let ((f-name (pathname-name f)))
(some (lambda (name)
(funcall test f-name name))
*album-cover-names*)))
image-files)
(first image-files))))
(make-copy-action :origin image-file
:target (pathname-normalize-unicode
(make-pathname
:name "cover"
:type (let ((type (string-downcase
(pathname-type image-file))))
;; NOTE: Auxio ignores .jpeg
(if (equal type "jpeg")
"jpg"
type))
:defaults target))))))
(defun get-all-copy-actions (origin target &optional (depth 0)) (defun get-all-copy-actions (origin target &optional (depth 0))
"Recursively iterate ORIGIN for files to copy. "Recursively iterate ORIGIN for files to copy.
@ -125,7 +152,10 @@ actions that need performing in order to store the targets as second value."
(fset:unionf files cue-copy-actions) (fset:unionf files cue-copy-actions)
(dolist (file (uiop:directory-files origin)) (dolist (file (uiop:directory-files origin))
(when-let ((action (make-file-copy-action file target))) (when-let ((action (make-file-copy-action file target)))
(fset:adjoinf files action)))))) (fset:adjoinf files action))))
(unless (fset:empty? files)
(when-let ((image-action (get-image-copy-action origin-files target)))
(fset:adjoinf files image-action)))))
(dolist (directory (uiop:subdirectories origin)) (dolist (directory (uiop:subdirectories origin))
(let ((target-directory (let ((target-directory
(make-pathname :directory (append (pathname-directory target) (make-pathname :directory (append (pathname-directory target)

4
sync-music/utils.lisp
View file

@ -17,6 +17,10 @@
"General file extensions that should be copied over.") "General file extensions that should be copied over.")
(defparameter *meta-extensions* '("cue" "m3u" "m3u8") (defparameter *meta-extensions* '("cue" "m3u" "m3u8")
"File extensions where *.flac text needs to be replaced.") "File extensions where *.flac text needs to be replaced.")
(defparameter *image-extensions* '("png" "jpg" "jpeg" "webp")
"File extensions for image files.")
(defparameter *album-cover-names* '("cover" "front" "folder")
"File names of album cover files.")
(defparameter *invalid-char-scanner* (ppcre:create-scanner "[\"*/:<>?\\\\|]") (defparameter *invalid-char-scanner* (ppcre:create-scanner "[\"*/:<>?\\\\|]")
"Scan for any characters not allowed in an Android/NTFS file name.") "Scan for any characters not allowed in an Android/NTFS file name.")