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

Merge branch 'main' of https://codeberg.org/hnmdijkema/audio-library-manager

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-01 13:41:23 +02:00
parent 2ab5803fc3 84680e8e6e
commit 976403f967
1 changed files with 68 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/file-walker.rkt
+68 -50
View File
@@ -19,14 +19,19 @@
(let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")))
(string-replace str "/" delim)))
(define (make-next-gen base-path glob-pattern)
(sequence->generator
(sequence-filter
(λ (p)
(let ((basename (file-name-from-path p)))
(glob-match? glob-pattern basename)))
(in-directory base-path))))
(define (make-file-walker base-path glob-pattern filter-func
#:filename-cleaner [filename-cleaner-func (λ (f) f)])
(let* ((gen (sequence->generator
(sequence-filter
(λ (p)
(let ((basename (file-name-from-path p)))
(glob-match? glob-pattern basename)))
(in-directory base-path))))
(let* ((gen (make-next-gen base-path glob-pattern))
(next-gens '())
(str-base-path* (format "~a" (normalize-path base-path)))
(delim (if (eq? (system-path-convention-type) 'windows) "\\" "/"))
(str-base-path (if (string-suffix? str-base-path* delim)
@@ -35,52 +40,65 @@
(base-path-len (string-length str-base-path))
(result #f)
)
(λ ()
(let ((path (gen)))
(if (void? path)
(values #f #f #f)
(let* ((bd (basedir path))
(bn (format "~a" (basename path)))
(nbn (filename-cleaner-func (clean-os-basename bn)))
)
(unless (string=? bn nbn)
(with-handlers ([exn? (λ (e)
(warn-am "Cannot rename dirty filename: ~a, ~a" nbn e))])
(info-am "Renaming ~a to ~a (basedir: ~a)" bn nbn bd)
(rename-file-or-directory (build-path bd bn)
(build-path bd nbn) #f)
(set! path (build-path bd nbn))
))
(let* ((str-path (path->string path))
(ext* (path-get-extension path))
(ext (string->symbol
(substring
(if (eq? ext* #f)
"."
(let ((e (string-downcase (bytes->string/utf-8 ext*))))
(if (string-contains? e " ")
"."
e))) 1)))
(path-part (substring str-path base-path-len))
(str-n-path (string-replace path-part "\\" "/"))
(info (let ((h (make-hash (list
(cons 'type 'dir)
(cons 'path str-n-path)
(cons 'ext ext)))))
(when (file-exists? path)
(hash-set! h 'type 'file)
(hash-set! h 'size (file-size path))
(hash-set! h 'mtime (file-or-directory-modify-seconds path))
)
h))
(letrec ((walker-func
(λ ()
(let ((path (gen)))
(if (void? path)
(if (null? next-gens)
(values #f #f #f)
(let ((n (car next-gens)))
(set! gen (cadr n))
(info-am "Walking ~a..." (car n))
(set! next-gens (cdr next-gens))
(walker-func)))
(let* ((bd (basedir path))
(bn (format "~a" (basename path)))
(nbn (filename-cleaner-func (clean-os-basename bn)))
)
(filter-func base-path path info))))
)
(unless (string=? bn nbn)
(with-handlers ([exn? (λ (e)
(warn-am "Cannot rename dirty filename: ~a, ~a" nbn e))])
(info-am "Renaming ~a to ~a (basedir: ~a)" bn nbn bd)
(rename-file-or-directory (build-path bd bn)
(build-path bd nbn) #f)
(set! path (build-path bd nbn))
(when (directory-exists? path)
(info-am "Adding directory ~a to next gens" nbn)
(set! next-gens (cons (list
nbn
(make-next-gen path glob-pattern))
next-gens)))
))
(let* ((str-path (path->string path))
(ext* (path-get-extension path))
(ext (string->symbol
(substring
(if (eq? ext* #f)
"."
(let ((e (string-downcase (bytes->string/utf-8 ext*))))
(if (string-contains? e " ")
"."
e))) 1)))
(path-part (substring str-path base-path-len))
(str-n-path (string-replace path-part "\\" "/"))
(info (let ((h (make-hash (list
(cons 'type 'dir)
(cons 'path str-n-path)
(cons 'ext ext)))))
(when (file-exists? path)
(hash-set! h 'type 'file)
(hash-set! h 'size (file-size path))
(hash-set! h 'mtime (file-or-directory-modify-seconds path))
)
h))
)
(filter-func base-path path info)))
)))))
walker-func
)
)
)
))
(define (make-file-admin base-path db-store #:filename-cleaner [fc-f (λ (f) f)])