(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. 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) ((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 :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. Return a set of all copy actions as first value, and set of all directory actions that need performing in order to store the targets as second value." (check-depth (incf depth)) (let ((files (fset:empty-set)) (directories (fset:empty-set))) (unless (and *ignore-toplevel-p* (= depth 1)) (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) (list (p-utils:directory-name directory)))))) (multiple-value-bind (subdir-files subdir-directories) (get-all-copy-actions directory target-directory depth) (fset:unionf files subdir-files) (fset:unionf directories subdir-directories)))) (when (and (fset:empty? directories) (fset:nonempty? files)) (fset:adjoinf directories (make-directory-action :target (pathname-normalize-unicode target)))) (values files directories))) (defun get-all-delete-actions (target &optional (depth 0)) "Recursively iterate TARGET for files to delete. Return a set of all preexisting files as first value, and set of all directories to not create as the second value." (check-depth (incf depth)) (let ((files (fset:empty-set)) (directories (fset:set (make-directory-action :target target)))) (unless (and *ignore-toplevel-p* (= depth 1)) (dolist (file (uiop:directory-files target)) (fset:adjoinf files (make-delete-action :target file)))) (dolist (directory (uiop:subdirectories target)) (multiple-value-bind (subdir-files subdir-directories) (get-all-delete-actions directory depth) (fset:unionf files subdir-files) (fset:unionf directories subdir-directories))) (values files directories))) (defun get-all-actions (origin target) "Consolidate all copy and delete actions from ORIGIN to TARGET. Return a set of all copy actions as first value, all delete actions as second value, and all directories that should be created as the third value." (let ((*max-depth* *max-depth*)) (mvlet ((all-copy all-directory (get-all-copy-actions origin target)) (all-delete all-directory-existing (get-all-delete-actions target))) (values (fset:set-difference all-copy all-delete) (if *cleanupp* (fset:set-difference all-delete all-copy) (fset:empty-set)) (fset:set-difference all-directory all-directory-existing))))) (defun perform-actions (actions &optional progress-handler) "Perform all ACTIONS in a parallelized manner. Main thread calls PROGRESS-HANDLER (if given) with the progress queue and the total task count as arguments." (let ((task-count (fset:size actions)) (channel (lparallel:make-channel)) (queue (when progress-handler (lparallel.queue:make-queue)))) (fset:do-set (action actions) (lparallel:submit-task channel #'action-perform action queue)) (when progress-handler (funcall progress-handler queue task-count)) (loop :repeat task-count :do (lparallel:receive-result channel)))) (defun clean-directory (target) "Delete all empty folders and folders containing only empty folders in TARGET." ;; NOTE: Want (every #'clean-directory ...) but without short-circuiting (and (every #'identity (mapcar #'clean-directory (uiop:subdirectories target))) (null (uiop:directory-files target)) (uiop:delete-empty-directory target))) (defun sync-music (origin target &key confirmp progress-handler) "Get and perform all actions from ORIGIN to TARGET. Calls CONFIRMP with all the actions and only continues if it returns non-NIL. Passes PROGRESS-HANDLER to PERFORM-ACTIONS." (let ((target-directory (uiop:resolve-location (ensure-directories-exist (uiop:merge-pathnames* (uiop:ensure-directory-pathname target))))) (origin-directory (uiop:directory-exists-p origin))) (unless origin-directory (error "Music directory `~A` does not exist!" origin)) (when (or (p-utils:subpath-p target-directory origin-directory) (p-utils:subpath-p origin-directory target-directory)) (error "Cannot sync if target or origin are a direct subpath of the other.")) (multiple-value-bind (copy-actions delete-actions directory-actions) (get-all-actions origin-directory target-directory) (and confirmp (not (funcall confirmp copy-actions delete-actions directory-actions)) (return-from sync-music)) (fset:do-set (action directory-actions) (action-perform action)) (lparallel.kernel-util:with-temp-kernel ((or *worker-threads* (max (- (count-cpus) 2) 1))) (perform-actions (fset:unionf copy-actions delete-actions) progress-handler)) (when *cleanupp* (clean-directory target-directory)))))