hans/audio-library-manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cleanup of directories not always

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-01 17:37:40 +02:00
parent 976403f967
commit 328371edfd
2 changed files with 6 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-manager.rkt
+1 -1
View File
@@ -479,7 +479,7 @@
(info-am "Finished walking music library") (info-am "Finished walking music library")
;; Cleanup files in target, not in source ;; Cleanup files in target, not in source
(info-am "Checking files in target, not in source") (info-am "Checking files in target, not in source")
(let ((fwt (make-file-walker opus-path "*" target-tree-cleaner))) (let ((fwt (make-file-walker opus-path "*" target-tree-cleaner #:clean-os-name #f)))
(let loop1 () (let loop1 ()
(let-values (((base-path path info) (fwt))) (let-values (((base-path path info) (fwt)))
(if (eq? info #f) (if (eq? info #f)
private/file-walker.rkt
+5 -3
View File
@@ -29,7 +29,8 @@
(define (make-file-walker base-path glob-pattern filter-func (define (make-file-walker base-path glob-pattern filter-func
#:filename-cleaner [filename-cleaner-func (λ (f) f)]) #:filename-cleaner [filename-cleaner-func (λ (f) f)]
#:clean-os-name [clean-os-name #t])
(let* ((gen (make-next-gen base-path glob-pattern)) (let* ((gen (make-next-gen base-path glob-pattern))
(next-gens '()) (next-gens '())
(str-base-path* (format "~a" (normalize-path base-path))) (str-base-path* (format "~a" (normalize-path base-path)))
@@ -53,13 +54,14 @@
(walker-func))) (walker-func)))
(let* ((bd (basedir path)) (let* ((bd (basedir path))
(bn (format "~a" (basename path))) (bn (format "~a" (basename path)))
(nbn (filename-cleaner-func (clean-os-basename bn))) (nbn* (if (eq? clean-os-name #t) (clean-os-basename bn) bn))
(nbn (format "~a" (filename-cleaner-func nbn*)))
) )
(unless (string=? bn nbn) (unless (string=? bn nbn)
(with-handlers ([exn? (λ (e) (with-handlers ([exn? (λ (e)
(warn-am "Cannot rename dirty filename: ~a, ~a" nbn e))]) (warn-am "Cannot rename dirty filename: ~a, ~a" nbn e))])
(info-am "Renaming ~a to ~a (basedir: ~a)" bn nbn bd) (info-am "Renaming '~a' to '~a' (basedir: ~a)" bn nbn bd)
(rename-file-or-directory (build-path bd bn) (rename-file-or-directory (build-path bd bn)
(build-path bd nbn) #f) (build-path bd nbn) #f)
(set! path (build-path bd nbn)) (set! path (build-path bd nbn))