From 3b61e358dc4b74d519df4707e908d6f9ced42169 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 10 Jun 2026 08:45:11 +0200 Subject: [PATCH] nog een --- README.md | 9 +- flac-48khz-manager.rkt | 22 ++--- flac2opus-manager.rkt | 11 +-- private/convert.rkt | 43 +++++++++ private/opus-convert.rkt | 112 ++++++++++++++++++++++++ private/scan.rkt | 27 +----- private/util.rkt | 17 ++-- scribblings/audio-library-manager.scrbl | 8 +- test/flac-48khz-manager-test.rkt | 2 +- test/flac2opus-manager-test.rkt | 2 +- 10 files changed, 190 insertions(+), 63 deletions(-) create mode 100644 private/convert.rkt create mode 100644 private/opus-convert.rkt diff --git a/README.md b/README.md index e5b7918..f30d104 100644 --- a/README.md +++ b/README.md @@ -21,9 +21,9 @@ absolute mount points are not stored, and path separators are always `/`. ## FLAC 48 kHz manager The command keeps a FLAC directory tree at a maximum sample rate of 48 kHz. -Files above the configured threshold are converted synchronously by the batch process. The conversion path uses `racket-audio/audio-encoder` dynamically, so the -package can still compile on systems where the native audio libraries are not -installed yet. +Files above the configured threshold are converted in place by a direct call to +`racket-audio/audio-encoder`. The conversion code is deliberately synchronous: +no places, channels or worker protocol are used. Run: @@ -63,7 +63,8 @@ as keyword argument: Metadata is copied through `racket-audio/taglib` and `racket-audio/audio-encoder`: ordinary TagLib properties are transferred, embedded pictures are transferred, -and an additional `FLAC2OPUS` comment is written to mark the conversion. +and an additional `FLAC2OPUS` comment is written to mark the conversion. The +batch converter itself remains a simple synchronous function call. The manager removes target files that belonged to source files which disappeared since the previous run. It deliberately does not mirror its own root-level diff --git a/flac-48khz-manager.rkt b/flac-48khz-manager.rkt index 3839f4c..b16eaf0 100644 --- a/flac-48khz-manager.rkt +++ b/flac-48khz-manager.rkt @@ -6,7 +6,7 @@ racket/path "private/audio.rkt" "private/manager-ini.rkt" - "private/convert-place.rkt" + "private/convert.rkt" "private/cover-art.rkt" "private/fingerprint.rkt" "private/hash.rkt" @@ -102,16 +102,16 @@ (values (summary-inc (summary-inc summary2 'skipped) 'dry-run) errors)) (begin (info-alm "converting ~a from ~a Hz to ~a Hz" relpath sample-rate (ini-ref/int ini 'manager 'max-sample-rate 48000)) - (let* ((result (convert-proc path - (ini-ref/int ini 'manager 'max-sample-rate 48000) - (ini-ref/int ini 'manager 'compression-level 5))) - (new-sample-rate (inspect-flac-proc path)) - (new-signature (file-signature path ini fingerprint-proc))) - (state-set-file! ks relpath - (state-info path new-signature 'converted new-sample-rate - (list (cons 'old-sample-rate sample-rate) - (cons 'encoder-result result)))) - (values (summary-inc summary2 'converted) errors))))] + (begin + (convert-proc path + (ini-ref/int ini 'manager 'max-sample-rate 48000) + (ini-ref/int ini 'manager 'compression-level 5)) + (let ([new-sample-rate (inspect-flac-proc path)] + [new-signature (file-signature path ini fingerprint-proc)]) + (state-set-file! ks relpath + (state-info path new-signature 'converted new-sample-rate + (list (cons 'old-sample-rate sample-rate)))) + (values (summary-inc summary2 'converted) errors)))))] [else (info-alm "ok: ~a (~a Hz)" relpath sample-rate) (state-set-file! ks relpath (state-info path signature 'ok sample-rate '())) diff --git a/flac2opus-manager.rkt b/flac2opus-manager.rkt index a68b980..1990e3d 100644 --- a/flac2opus-manager.rkt +++ b/flac2opus-manager.rkt @@ -10,7 +10,7 @@ "private/hash.rkt" "private/log.rkt" "private/mail.rkt" - "private/opus-convert-place.rkt" + "private/opus-convert.rkt" "private/report.rkt" "private/util.rkt") @@ -139,10 +139,9 @@ [(flac-path? path) (info-alm "converting ~a -> ~a at ~a kbps" relpath target-relpath kbps) (delete-old-target-if-needed! target-dir old target-relpath) - (define result (convert-proc path target-path kbps)) + (convert-proc path target-path kbps) (flac2opus-state-set-file! ks relpath - (state-info path target-relpath signature 'converted kbps - (list (cons 'encoder-result result)))) + (state-info path target-relpath signature 'converted kbps '())) (values (summary-inc summary2 'converted) errors)] [else (info-alm "copying ~a -> ~a" relpath target-relpath) @@ -168,9 +167,7 @@ (summary-inc s 'removed))))) (define (find-source-files source-dir) - (filter (lambda (p) - (and (not (manager-temp-path? p)) - (not (manager-admin-relpath? (source-relpath-string source-dir p))))) + (filter (lambda (p) (not (manager-admin-relpath? (source-relpath-string source-dir p)))) (directory-file-paths source-dir))) (define (manage-flac2opus-tree source-directory target-directory diff --git a/private/convert.rkt b/private/convert.rkt new file mode 100644 index 0000000..adc69cb --- /dev/null +++ b/private/convert.rkt @@ -0,0 +1,43 @@ +#lang racket/base + +(require racket/file + racket/path + "util.rkt") + +(provide convert-flac-to-target-in-place) + +(define (temp-output-path input-path) + (define-values (base name dir?) (split-path input-path)) + (define name-str (path->string name)) + (build-path base (format ".~a.tmp-~a.flac" name-str (current-inexact-milliseconds)))) + +(define (delete-file/quiet! p) + (with-handlers ([exn:fail? (lambda (_) (void))]) + (when (file-exists? p) (delete-file p)))) + +(define (settings max-sample-rate compression-level) + (make-immutable-hash + (list (cons 'target-sample-rate max-sample-rate) + (cons 'compression-level compression-level)))) + +(define (call-audio-encode audio-encode in-file out-file settings progress-callback) + (if progress-callback + (audio-encode in-file out-file settings + #:encoder 'flac + #:copy-tags? #t + #:progress-callback progress-callback) + (audio-encode in-file out-file settings + #:encoder 'flac + #:copy-tags? #t))) + +(define (convert-flac-to-target-in-place input-path max-sample-rate compression-level + #:progress-callback [progress-callback #f]) + (define tmp-path (temp-output-path input-path)) + (with-handlers ([exn:break? (lambda (e) (delete-file/quiet! tmp-path) (raise e))] + [exn:fail? (lambda (e) (delete-file/quiet! tmp-path) (raise e))]) + (define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode)) + (define result (call-audio-encode audio-encode input-path tmp-path + (settings max-sample-rate compression-level) + progress-callback)) + (rename-file-or-directory tmp-path input-path #t) + result)) diff --git a/private/opus-convert.rkt b/private/opus-convert.rkt new file mode 100644 index 0000000..cf47601 --- /dev/null +++ b/private/opus-convert.rkt @@ -0,0 +1,112 @@ +#lang racket/base + +(require racket/file + racket/list + racket/path + racket/string + "util.rkt") + +(provide convert-flac-to-opus) + +(define conversion-note "Converted from FLAC to Opus by flac2opus-manager") + +(define (temp-output-path output-path) + (define-values (base name dir?) (split-path output-path)) + (define name-str (if (path? name) (path->string name) "output.opus")) + (build-path base (format ".~a.tmp-~a.opus" name-str (current-inexact-milliseconds)))) + +(define (delete-file/quiet! p) + (with-handlers ([exn:fail? (lambda (_) (void))]) + (when (file-exists? p) (delete-file p)))) + +(define (list-of-strings? v) + (and (list? v) (andmap string? v))) + +(define (property-key-symbol k) + (cond [(symbol? k) k] + [(string? k) (string->symbol (string-downcase k))] + [else (string->symbol (string-downcase (format "~a" k)))])) + +(define (first-comment-value v) + (cond [(and (pair? v) (string? (car v))) (car v)] + [(string? v) v] + [else #f])) + +(define (source-tags-data input-file) + (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags)) + (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?)) + (define tags-keys (dynamic-require 'racket-audio/taglib 'tags-keys)) + (define tags-ref (dynamic-require 'racket-audio/taglib 'tags-ref)) + (define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture)) + (call-with-id3-tags + input-file + (lambda (tags) + (if (not (tags-valid? tags)) + (list (cons 'properties '()) (cons 'picture #f)) + (let* ((keys (sort (tags-keys tags) stringsettings input-file kbps) + (define data (source-tags-data input-file)) + (define properties (alist-ref/default data 'properties '())) + (define picture (alist-ref/default data 'picture #f)) + (define comments (make-hash)) + (for ([kv (in-list properties)]) + (define v (first-comment-value (cdr kv))) + (when v (hash-set! comments (car kv) v))) + (hash-set! comments 'flac2opus conversion-note) + (define settings (make-hash)) + (hash-set! settings 'bitrate (* kbps 1000)) + (hash-set! settings 'vbr? #t) + (hash-set! settings 'comments comments) + ;; Do not put the id3-picture struct in settings. It makes the encoder result + ;; harder to store or serialize, and the picture is copied explicitly below. + (values settings properties picture)) + +(define (copy-all-tag-properties! output-file properties picture) + (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags)) + (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?)) + (define tags-set-values! (dynamic-require 'racket-audio/taglib 'tags-set-values!)) + (define tags-set! (dynamic-require 'racket-audio/taglib 'tags-set!)) + (define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!)) + (define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!)) + (call-with-id3-tags + output-file + (lambda (tags) + (when (tags-valid? tags) + (for ([kv (in-list properties)]) + (define v (cdr kv)) + (cond [(list-of-strings? v) (tags-set-values! tags (car kv) v)] + [(string? v) (tags-set! tags (car kv) v)] + [else (void)])) + (tags-set! tags 'flac2opus conversion-note) + (unless (eq? picture #f) (tags-picture! tags picture)) + (tags-save! tags))) + #:mode 'read-write)) + +(define (call-audio-encode audio-encode in-file out-file settings progress-callback) + (if progress-callback + (audio-encode in-file out-file settings + #:encoder 'opus + #:copy-tags? #f + #:progress-callback progress-callback) + (audio-encode in-file out-file settings + #:encoder 'opus + #:copy-tags? #f))) + +(define (convert-flac-to-opus input-path output-path kbps #:progress-callback [progress-callback #f]) + (define tmp-path (temp-output-path output-path)) + (ensure-parent-directory! tmp-path) + (with-handlers ([exn:break? (lambda (e) (delete-file/quiet! tmp-path) (raise e))] + [exn:fail? (lambda (e) (delete-file/quiet! tmp-path) (raise e))]) + (define-values (settings properties picture) (source-tags->settings input-path kbps)) + (define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode)) + (define result (call-audio-encode audio-encode input-path tmp-path settings progress-callback)) + (copy-all-tag-properties! tmp-path properties picture) + (ensure-parent-directory! output-path) + (rename-file-or-directory tmp-path output-path #t) + result)) diff --git a/private/scan.rkt b/private/scan.rkt index 8a3c998..9d0c700 100644 --- a/private/scan.rkt +++ b/private/scan.rkt @@ -7,34 +7,11 @@ (provide find-flac-files find-regular-files) -(define (directory-list/quiet dir) - (with-handlers ([exn:fail? (lambda (_) '())]) - (directory-list dir #:build? #t))) - -(define (directory-exists?/quiet p) - (with-handlers ([exn:fail? (lambda (_) #f)]) - (directory-exists? p))) - -(define (file-exists?/quiet p) - (with-handlers ([exn:fail? (lambda (_) #f)]) - (file-exists? p))) - (define (sort-paths paths) (sort paths stringstring)) (define (find-regular-files base-dir) - ;; Do not use racket/file:find-files here. On Windows UNC trees, especially - ;; with long paths, fold-files can raise "path disappeared" for a single - ;; entry and abort the whole scan. This walker treats entries that disappear, - ;; are inaccessible, or cannot be represented by the platform path layer as a - ;; skipped entry and continues the scan. - (define root (filesystem-path base-dir)) - (let loop ([dir root] [acc '()]) - (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))]) - (cond [(directory-exists?/quiet p) (loop p acc)] - [(file-exists?/quiet p) (cons p acc)] - [else acc])))) + (sort-paths (directory-file-paths base-dir))) (define (find-flac-files base-dir) - (sort-paths (filter (lambda (p) (and (flac-path? p) (not (manager-temp-path? p)))) - (find-regular-files base-dir)))) + (filter flac-path? (find-regular-files base-dir))) diff --git a/private/util.rkt b/private/util.rkt index ea5f2f9..9bc4bbf 100644 --- a/private/util.rkt +++ b/private/util.rkt @@ -113,22 +113,17 @@ (define (file-exists?/quiet p) (with-handlers ([exn:fail? (lambda (_) #f)]) (file-exists? p))) -(define (path-file-name-string p) - (let-values ([(base name dir?) (split-path p)]) - (and (path? name) (path->string name)))) - -(define (manager-temp-path? p) - (define name (path-file-name-string p)) - (and name - (string-prefix? name ".") - (regexp-match? #rx"\\.tmp-[0-9.]+\\.(flac|opus)$" name))) - (define (flac-path? p) (and (file-exists?/quiet p) (extension-ci=? p ".flac"))) (define (opus-path? p) (and (file-exists?/quiet p) (extension-ci=? p ".opus"))) +(define (manager-temp-path? p) + (define-values (_base name _dir?) (split-path p)) + (and (path? name) + (regexp-match? #rx"^\\..*\\.tmp-[0-9.]+\\.(flac|opus)$" (path->string name)))) + (define (regular-file-path? p) (file-exists?/quiet p)) @@ -150,7 +145,7 @@ (let loop ([dir root] [acc '()]) (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))]) (cond [(directory-exists?/quiet p) (loop p acc)] - [(file-exists?/quiet p) (cons p acc)] + [(and (file-exists?/quiet p) (not (manager-temp-path? p))) (cons p acc)] [else acc])))) (define (replace-path-extension p ext) diff --git a/scribblings/audio-library-manager.scrbl b/scribblings/audio-library-manager.scrbl index e4ea9ca..d9ab1df 100644 --- a/scribblings/audio-library-manager.scrbl +++ b/scribblings/audio-library-manager.scrbl @@ -24,9 +24,10 @@ so it can share the same database with the 48 kHz manager. @section{FLAC 48 kHz manager} The tool @filepath{flac-48khz-manager.rkt} keeps a FLAC tree at a maximum sample -rate of 48 kHz. Files with a higher sample rate are converted synchronously by the batch process. The conversion path uses -@racketmodname[racket-audio/audio-encoder] dynamically, so the manager module can -still be compiled on systems where the native audio libraries are not available. +rate of 48 kHz. Files with a higher sample rate are converted in place by a +direct call to @racketmodname[racket-audio/audio-encoder]. The batch conversion +path is deliberately synchronous; it does not use places, channels or a worker +protocol. Run the manager as: @@ -60,6 +61,7 @@ Metadata is copied through @racketmodname[racket-audio/taglib] and @racketmodname[racket-audio/audio-encoder]. TagLib properties and embedded pictures are transferred to the Opus file. The manager also writes a @tt{FLAC2OPUS} comment indicating that the file was converted by the manager. +The conversion function is a normal synchronous function call. When a source file disappears, the corresponding target file is removed on the next run. The manager does not mirror its own root-level administration files. diff --git a/test/flac-48khz-manager-test.rkt b/test/flac-48khz-manager-test.rkt index f119d7e..65949f9 100644 --- a/test/flac-48khz-manager-test.rkt +++ b/test/flac-48khz-manager-test.rkt @@ -58,7 +58,7 @@ (set! convert-count (add1 convert-count)) (call-with-output-file p #:exists 'replace (lambda (out) (fprintf out "converted to ~a compression ~a" rate compression))) - (list (cons 'mock #t) (cons 'target-sample-rate rate))) + (lambda () rate)) (define first-summary (manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert)) diff --git a/test/flac2opus-manager-test.rkt b/test/flac2opus-manager-test.rkt index 605653b..41647eb 100644 --- a/test/flac2opus-manager-test.rkt +++ b/test/flac2opus-manager-test.rkt @@ -33,7 +33,7 @@ (make-directory* (let-values ([(base name dir?) (split-path dst)]) base)) (call-with-output-file dst #:exists 'replace (lambda (o) (fprintf o "opus from ~a at ~a" (path->string src) kbps))) - (list (cons 'mock #t) (cons 'kbps kbps))) + (lambda () kbps)) (define first-summary (manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))