diff --git a/audio-manager.rkt b/audio-manager.rkt index 16f27a7..aa2d7df 100644 --- a/audio-manager.rkt +++ b/audio-manager.rkt @@ -449,7 +449,7 @@ (info-am "Setting log level to ~a" log-level) (sl-set-log-level log-level) - (let ((fw (make-file-admin music-path file-db-store))) + (let ((fw (make-file-admin music-path file-db-store #:filename-cleaner clean-audio-basename))) ;; Enrichment phase (set! fw (fw-add-step fw adjust-ext)) (set! fw (fw-add-step fw flac-with-id3)) @@ -499,3 +499,37 @@ ) +(require racket/string) + +(define (clean-audio-basename name) + (let* ((s0 (format "~a" name)) + + ;; Laatste .ext apart houden, zodat we alleen de stem opschonen. + ;; "Gypsy Festival vol. 2" blijft dus gewoon een directorynaam. + (m (regexp-match #px"^(.*)(\\.[A-Za-z0-9][A-Za-z0-9_-]{0,15})$" s0)) + (stem0 (if m (list-ref m 1) s0)) + (ext (if m (list-ref m 2) "")) + + ;; Audio-technische suffixen verwijderen: + ;; [16B-44.1kHz], [24B-44.1kHz], [24bit-96 kHz], etc. + (stem1 (regexp-replace* + #px"(?i:\\s*\\[(16|24|32)\\s*(b|bit)\\s*[-_ ]\\s*[0-9]+(?:\\.[0-9]+)?\\s*k\\s*hz\\]\\s*)" + stem0 + " ")) + + ;; Underscores als simpele titel-markering opruimen: + ;; _Rosamunde_ -> Rosamunde + ;; Schubert_ String -> Schubert String + ;; + ;; Bewust geen liggende streepjes normaliseren. + (stem2 (regexp-replace* #px"_+" stem1 " ")) + + ;; Whitespace normaliseren. + (stem3 (regexp-replace* #px"\\s+" stem2 " ")) + + ;; Alleen de stem trimmen. + ;; Geen '-' trimmen; dat is een gewoon teken. + (stem4 (string-trim stem3 " .")) + + (stem5 (if (string=? stem4 "") "_" stem4))) + (string-append stem5 ext))) diff --git a/private/file-walker.rkt b/private/file-walker.rkt index 9b89c2f..9f33272 100644 --- a/private/file-walker.rkt +++ b/private/file-walker.rkt @@ -46,10 +46,10 @@ (unless (string=? bn nbn) (with-handlers ([exn? (λ (e) - (warn-am "Cannot rename dirty filename: ~a" nbn))]) - (info-am "Renaming ~a to ~a" bn nbn) + (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 bn nbn) #f) + (build-path bd nbn) #f) (set! path (build-path bd nbn)) ))